/** \brief free's all memory in EEG-struct.
including the data
\param eeg
*/
void eeg_free( EEG *eeg ){
safer_free( eeg->filename );
safer_free( eeg->comment );
array_free( eeg->times);
array_free( eeg->data );
array_free( eeg->markers );
array_free( eeg->marker_type );
slist_free( eeg->marker_types );
if( eeg->additional )
free( eeg->additional );
safer_free( eeg->chaninfo );
safer_free( eeg );
}
void
free_elemStorage(ELEM_BLK_STRUCT *eb_ptr)
/*****************************************************************
*
* free_elemStorage()
*
*
* frees the storage in the Element_Storage structure.
* Note, currently, memory is allocated in two chunks for space
* savings. Thus, we free the two chunks here.
*****************************************************************/
{
ELEMENT_STORAGE_STRUCT *s_ptr = eb_ptr->ElemStorage;
if (s_ptr) {
safer_free((void **) &(s_ptr->Sat_QP_tn));
safer_free((void **) &(eb_ptr->ElemStorage));
}
}
NODAL_VARS_STRUCT *
copy_and_rearrange_nv(NODAL_VARS_STRUCT *nv_old)
/*****************************************************************
*
* copy_and_rearrange_nv():
*
* This function copies an old nodal variable structure into
* a new one, rearranging the order of the variables as it
* goes.
* This function sets the order in the solution vector. Right
* now, the order of the solution vector is set to its original
* GOMA one:
* Outer to Inner:
* var_type
* sub_var_type
* matID
* This is not necessarily how it should be for optimal
* speed, however. In particular the species unknowns should
* be grouped together. Therefore, rearrangement of the
* solution vector might occur in the future.
*****************************************************************/
{
int var_type, subvarIndex = 0;
int *rec_used;
NODAL_VARS_STRUCT *nv_new = alloc_struct_1(NODAL_VARS_STRUCT, 1);
nv_new->list_index = nv_old->list_index;
/*
* Note: It is permissible to have nodes with zero unknowns defined
* on them. For example, if the element is quadratic and the
* variable interpolations are all Q1, the extra nodes in each
* element will not have any unknowns assigned to them. This
* is a waste, but it is permissible.
*/
if (nv_old->Num_Var_Desc == 0) {
return nv_new;
}
rec_used = alloc_int_1(nv_old->Num_Var_Desc, 0);
for (var_type = V_FIRST; var_type < V_LAST; var_type++) {
if (var_type == MASS_FRACTION) {
for (subvarIndex = 0; subvarIndex < upd->Max_Num_Species_Eqn;
subvarIndex++) {
rearrange_mat_increasing(var_type, subvarIndex, nv_old, nv_new,
rec_used);
}
} else {
rearrange_mat_increasing(var_type, 0, nv_old, nv_new, rec_used);
}
}
safer_free((void **) &rec_used);
return nv_new;
}
void
variable_description_free(VARIABLE_DESCRIPTION_STRUCT *vd)
/*************************************************************************
*
* variable_description_free():
*
* Frees memory allocated underneath the variable_description
* structure, and returns the structure to its default condition.
* This is the reverse of the _alloc() operation.
************************************************************************/
{
int i;
for (i = 0; i < vd->Ndof; i++) {
safer_free((void **) &(vd->Var_Name[i]));
}
safer_free((void **) &(vd->double_work));
safer_free((void **) &(vd->integer_work));
(void) variable_description_default(vd);
}
void
nodal_vars_free(NODAL_VARS_STRUCT *nv)
/*************************************************************************
*
* nodal_vars_free():
*
* Frees memory allocated underneath the nodal_vars
* structure, and returns the structure to its default condition.
* This is the reverse of the _alloc() operation. Note, there is
* no _alloc() procedure for this structure. It is actually populated
* by repeated calls to add_var_to_nv_struct(). Thus, this routine
* serves to undo whatever was malloced by repeated calls to
* add_var_to_nv_struct().
************************************************************************/
{
int v;
for (v = 0; v < V_LAST; v++) {
safer_free((void **) &(nv->Var_Type_Index[v]));
}
safer_free((void **) &(nv->Var_Desc_List));
safer_free((void **) &(nv->Nodal_Offset));
(void) memset((void *)nv, 0, sizeof(NODAL_VARS_STRUCT));
}
int
deinit_vhost_net(vhost_net *client) {
Vhost_Client *deinit_vhost_client = NULL;
if (!client) {
return E_VHOST_NET_ERR_FARG;
}
deinit_vhost_client = (Vhost_Client *) client->context;
vhost_client_delete_Vhost_Client(deinit_vhost_client);
safer_free(((void**)&(client)));
return E_VHOST_NET_OK;
}
void
free_element_blocks(void)
/*****************************************************************
*
* fee_element_blocks()
*
*
* frees the storage in the Element Blocks structure and all
* underlying storage
*****************************************************************/
{
free_element_storage();
safer_free((void **) &Element_Blocks);
}
void
variable_description_destroy(VARIABLE_DESCRIPTION_STRUCT **vd_hdl)
/*************************************************************************
*
* variable_description_destroy():
*
* Free memory required by the variable description structure.
* This routine basically unmallocs whatever variable_description_alloc
* malloced previously, and then unmallocs the variable
* description structure itself.
*
* Note, this is the opposite of the _create routine.
***************************************************************************/
{
variable_description_free(*vd_hdl);
safer_free((void **) vd_hdl);
}
void
nodal_vars_destroy(NODAL_VARS_STRUCT **nv_hdl)
/*************************************************************************
*
* nodal_vars_destroy():
*
* Free memory required by the nodal_vars structure.
* This routine basically unmallocs whatever nodal_vars_alloc
* malloced previously, and then unmallocs the variable
* description structure itself.
*
* Note, this is the opposite of the _create routine.
*************************************************************************/
{
nodal_vars_free(*nv_hdl);
safer_free((void **) nv_hdl);
}
void
initialize_goma_export_vars_ ( int *nnodes,
int *nelems,
int *nnv_in,
int *nev_in,
int *nnod_r,
int *i_soln,
double *xnv_in,
double *xev_in,
double *xsoln )
{
double *x;
int ev;
int I;
int ie;
int offset;
asdv(&x, NumUnknowns);
init_vec(x, cx, EXO_ptr, DPI_ptr, NULL, 0);
/*
* Goma export variables. may be read from material files or from preexisting exodus file
*/
for( ev=0; ev< *i_soln; ev++)
{
offset = *nnod_r*ev;
for( I=0; I< *nnod_r; I++ )
{
ie = Index_Solution( I,Export_XS_ID[ev], 0, 0, -1);
if( ie != -1 ) xsoln[offset+I] = x[ie];
}
}
safer_free( (void **) &x );
return;
}
void
ReduceBcast_BOR(int *ivec, int length)
/********************************************************************
*
* ReduceBcast_BOR()
*
* Does a logical bitwize OR operation on a vector of ints
* distibuted across different processors.
********************************************************************/
{
#ifdef PARALLEL
int k, err, *ivec_recv;
if (length <= 0) {
printf(" ReduceBcast_BOR Warning, length = %d\n", length);
return;
}
if (ivec == NULL) {
EH(-1, " ReduceBcast_BOR fatal Interface error");
}
ivec_recv = alloc_int_1(length, INT_NOINIT);
err = MPI_Reduce(ivec, ivec_recv, length, MPI_INT, MPI_BOR, 0,
MPI_COMM_WORLD);
if (err != MPI_SUCCESS) {
EH(-1, " ReduceBcast_BOR fatal MPI Error");
}
err = MPI_Bcast(ivec_recv, V_LAST, MPI_INT, 0, MPI_COMM_WORLD);
if (err != MPI_SUCCESS) {
EH(-1, " ReduceBcast_BOR fatal MPI Error");
}
for (k = 0; k < V_LAST; k++) {
ivec[k] = ivec_recv[k];
}
safer_free((void **) &ivec_recv);
#endif
}
void
add_qa_stamp(Exo_DB *exo)
{
int i;
int j;
int k;
int n;
/* char *new[MAX_QA][4];*/
QA_Record *Q;
n = exo->num_qa_rec;
if ( n > MAX_QA - 1 )
{
return;
}
exo->num_qa_rec++;
Q = (QA_Record *) smalloc( (exo->num_qa_rec)*sizeof(QA_Record));
for (i=0; i<exo->num_qa_rec; i++)
{
for (j=0; j<4; j++)
{
Q[i][j] = (char *) smalloc(LEN_QA_RECORD*sizeof(char));
/*
* Initialize to null terminators...
*/
for (k=0; k<LEN_QA_RECORD; k++)
{
Q[i][j][k] = '\0';
}
}
}
/*
* Copy any old stuff into the new area.
*/
for ( i=0; i<exo->num_qa_rec-1; i++)
{
for ( j=0; j<4; j++)
{
strcpy(Q[i][j], exo->qa_record[i][j]);
}
}
/*
* Preload new record with all terminating nulls.
*/
for ( j=0; j<4; j++)
{
for ( k=0; k<MAX_STR_LENGTH; k++)
{
Q[n][j][k] = '\0';
}
}
/*
* Concoct a new record.
*/
strcpy(Q[n][0], "GOMA");
strcpy(Q[n][1], GOMA_VERSION); /* def'd in std.h for now */
get_date(Q[n][2]);
get_time(Q[n][3]);
/*
* Free the old record members.
*/
for ( i=0; i<n; i++)
{
for ( j=0; j<4; j++)
{
safer_free((void **)&(exo->qa_record[i][j]));
}
}
if ( n > 0 )
{
safer_free((void **)&(exo->qa_record));
}
/*
* Assign new pointer.
*/
exo->qa_record = Q;
return;
}
int goma_close_(dbl *time1)
{
/*declare some variables here */
/* Local Declarations */
double time_start=*time1, total_time; /* timing variables */
static const char *yo="goma_solve";
#ifndef PARALLEL
struct tm *tm_ptr; /* additional serial timing variables */
time_t the_time;
#endif
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* FREE MEMORY ALLOCATED BY THE PROGRAM
*/
/*
* free the element block / element based structures
*/
free_element_blocks();
/*
* free nodal based structures
*/
free_nodes();
/*
* Free command line stuff
*/
safer_free( ( void ** ) Argv );
/* if ( ProcID == 0 ) */
/* { */
/* if ( argc > 1 ) */
/* { */
/* for (i=0; i<argc; i++) */
/* { */
/* #ifdef DEBUG */
/* fprintf(stderr, "clc[%d]->string &= 0x%x\n", i, clc[i]->string); */
/* fprintf(stderr, "clc[%d] &= 0x%x\n", i, clc[i]); */
/* #endif */
/* safer_free((void **) &(clc[i]->string)); */
/* safer_free((void **) (clc + i)); */
/* } */
/* safer_free((void **) &clc); */
/* } */
/* } */
/*
* Free exodus database structures
*/
free_exo(EXO_ptr);
safer_free((void **) &EXO_ptr);
if ( Num_Proc > 1 )
{
free_dpi(DPI_ptr);
}
else
{
free_dpi_uni(DPI_ptr);
}
safer_free((void **) &DPI_ptr);
/*
* Remove front scratch file [/tmp/lu.'pid'.0]
*/
if (Linear_Solver == FRONT)
{
unlerr = unlink(front_scratch_directory);
EH(unlerr, "Unlink problem with front scratch file");
}
#ifdef PARALLEL
total_time = ( MPI_Wtime() - time_start )/ 60. ;
DPRINTF(stderr, "\nProc 0 runtime: %10.2f Minutes.\n\n",total_time);
MPI_Finalize();
#else
(void) time(&the_time);
tm_ptr = gmtime(&the_time);
total_time = (double) ( ( tm_ptr->tm_sec
+ 60. * ( 60. * ( tm_ptr->tm_yday * 24. + tm_ptr->tm_hour )
+ tm_ptr->tm_min )
- time_start ) / 60.
);
fprintf(stderr, "\nProc 0 runtime: %10.2f Minutes.\n\n",total_time);
#endif
log_msg("GOMA ends normally.");
return (0);
}
void
set_init_Element_Storage(ELEM_BLK_STRUCT *eb_ptr, int mn)
/*****************************************************************
*
* set_init_Element_Storage()
*
*
* like its predecessor init_element_storage, this function actually
* places initial values for the draining and wetting curves for the
* TANH_HYST function, according to the request in the material property
* database cards for the current material
*
*****************************************************************/
{
int ielem_type, ip_total, i, j, ifound, ip;
double sat_switch = 0.0, pc_switch = 0.0, Draining_curve, *ev_tmp;
int error, num_dim, num_nodes;
int num_elem, num_elem_blk, num_node_sets, num_side_sets, time_step;
float version; /* version number of EXODUS II */
int exoid; /* ID of the open EXODUS II file */
char title[MAX_LINE_LENGTH]; /* title of the EXODUS II database */
float ret_float; /* any returned float */
char ret_char[3]; /* any returned character */
int num_vars; /* number of var_type variables */
char **var_names = NULL; /* array containing num_vars variable names */
char appended_name[MAX_VAR_NAME_LNGTH];
/*Quick return if model is not hysteretic in nature */
if(mp_glob[mn]->SaturationModel == TANH_HYST)
{
ielem_type = eb_ptr->Elem_Type;
ip_total = eb_ptr->IP_total;
Draining_curve = mp_glob[mn]->u_saturation[8];
if (Guess_Flag ==4 || Guess_Flag == 5)
{
EH(-1,"Not a smooth restart for hysteretic saturation function. If you really want to do this use read_exoII_file or call us");
}
if(Guess_Flag == 5 || Guess_Flag == 6)
{
WH(-1,"Initializing Hysteretic Curve values at all Gauss points with read_exoII_file");
CPU_word_size = sizeof(double);
IO_word_size = 0;
exoid = ex_open(ExoAuxFile, EX_READ, &CPU_word_size, &IO_word_size , &version);
EH(exoid, "ex_open");
error = ex_get_init(exoid, title, &num_dim, &num_nodes, &num_elem,
&num_elem_blk, &num_node_sets, &num_side_sets);
EH(error, "ex_get_init for efv or init guess");
/*
* Obtain the number of time steps in the exodus file, time_step,
* We will read only from the last time step
*/
error = ex_inquire(exoid, EX_INQ_TIME, &time_step, &ret_float, ret_char);
EH(error, "ex_inquire");
/* Based on problem type and available info in database, extract
* appropriate fields
*/
/*
* Get the number of nodal variables in the file, and allocate
* space for storage of their names.
*/
error = ex_get_var_param(exoid, "e", &num_vars);
EH(error, "ex_get_var_param");
/* First extract all nodal variable names in exoII database */
if (num_vars > 0) {
var_names = alloc_VecFixedStrings(num_vars, (MAX_STR_LENGTH+1));
error = ex_get_var_names(exoid, "e", num_vars, var_names);
EH(error, "ex_get_var_names");
for (i = 0; i < num_vars; i++) strip(var_names[i]);
} else {
fprintf(stderr,
"Warning: no element variables for saturation stored in exoII input file.\n");
}
/*****THIS IS WHERE YOU LOAD THEM UP ******/
ev_tmp = (double *) smalloc(eb_ptr->Num_Elems_In_Block* sizeof(double));
ifound = 0;
for(ip = 0; ip < ip_total; ip++)
{
sprintf(appended_name, "sat_curve_type%d", ip );
for(j=0; j < num_vars; j++)
{
if(!strcasecmp(appended_name,var_names[j]))
{
/*Found variable so load it into element storage */
error = ex_get_elem_var(exoid, time_step, j+1,
eb_ptr->Elem_Blk_Id,
eb_ptr->Num_Elems_In_Block,
ev_tmp);
ifound = 1;
}
}
if(ifound)
{
for (i = 0; i < eb_ptr->Num_Elems_In_Block; i++)
{
eb_ptr->ElemStorage[i].sat_curve_type[ip] = ev_tmp[i];
}
}
else
{
EH(-1,"Cannot find an element variable for sat. hysteresis");
}
ifound = 0;
sprintf(appended_name, "sat_switch%d", ip );
for(j=0; j < num_vars; j++)
{
if(!strcasecmp(appended_name,var_names[j]))
{
/*Found variable so load it into element storage */
error = ex_get_elem_var(exoid, time_step, j+1,
eb_ptr->Elem_Blk_Id,
eb_ptr->Num_Elems_In_Block,
ev_tmp);
ifound = 1;
}
}
if(ifound)
{
for (i = 0; i < eb_ptr->Num_Elems_In_Block; i++)
{
eb_ptr->ElemStorage[i].Sat_QP_tn[ip] = ev_tmp[i];
}
}
else
{
EH(-1,"Cannot find an element variable for sat. hysteresis");
}
ifound = 0;
sprintf(appended_name, "pc_switch%d", ip );
for(j=0; j < num_vars; j++)
{
if(!strcasecmp(appended_name,var_names[j]))
{
/*Found variable so load it into element storage */
error = ex_get_elem_var(exoid, time_step, j+1,
eb_ptr->Elem_Blk_Id,
eb_ptr->Num_Elems_In_Block,
ev_tmp);
ifound = 1;
}
}
if(ifound)
{
for (i = 0; i < eb_ptr->Num_Elems_In_Block; i++)
{
eb_ptr->ElemStorage[i].p_cap_QP[ip] = ev_tmp[i];
}
}
else
{
EH(-1,"Cannot find an element variable for sat. hysteresis");
}
}
error = ex_close(exoid);
safer_free((void **) &var_names);
free(ev_tmp);
}
else /*Initialize as dictated by input cards */
{
if(Draining_curve == 1.0)
{
sat_switch = mp->u_saturation[0];
pc_switch = 1.e-12;
}
else if (Draining_curve == 0.0)
{
double sat_max = mp->u_saturation[0];
double sat_min = mp->u_saturation[4];
double alpha_w = mp->u_saturation[3];
double beta_w = mp->u_saturation[2];
pc_switch = 1.e12*alpha_w;
sat_switch = sat_max - ( sat_max - sat_min)*0.5*(1.0+tanh( beta_w - alpha_w/pc_switch ) ) ;
}
else
{
EH(-1,"TANH_HYST must have 1.0 or 0.0 in 9th spot");
}
for (i = 0; i < eb_ptr->Num_Elems_In_Block; i++)
{
for(ip = 0; ip < ip_total; ip++)
{
eb_ptr->ElemStorage[i].p_cap_QP[ip] = pc_switch;
eb_ptr->ElemStorage[i].Sat_QP_tn[ip] = sat_switch;
eb_ptr->ElemStorage[i].sat_curve_type[ip] = Draining_curve;
}
}
}
}
if(elc_glob[mn]->thermal_expansion_model == SHRINKAGE)
{
ip_total = eb_ptr->IP_total;
if (Guess_Flag ==4 || Guess_Flag == 5)
{
EH(-1,"Not a smooth restart for solidification shrinkage model.Use read_exoII_file or call us");
}
if(Guess_Flag == 5 || Guess_Flag == 6)
{
EH(-1,"Initializing solidified shrinkage model from exoII file not available yet. Use zero");
}
// Load em up as all unsolidified
for(ip = 0; ip < ip_total; ip++)
{
for (i = 0; i < eb_ptr->Num_Elems_In_Block; i++)
{
eb_ptr->ElemStorage[i].solidified[ip] = 0.0;
}
}
}
}
int
main(int argc, char **argv)
/*
* Initial main driver for GOMA. Derived from a (1/93) release of
* the rf_salsa program by
*
* Original Authors: John Shadid (1421)
* Scott Hutchinson (1421)
* Harry Moffat (1421)
*
* Date: 12/3/92
*
*
* Updates and Changes by:
* Randy Schunk (9111)
* P. A. Sackinger (9111)
* R. R. Rao (9111)
* R. A. Cairncross (Univ. of Delaware)
* Dates: 2/93 - 6/96
*
* Modified for continuation
* Ian Gates
* Dates: 2/98 - 10/98
* Dates: 7/99 - 8/99
*
* Last modified: Wed June 26 14:21:35 MST 1994 [email protected]
* Hello.
*
* Note: Many modifications from an early 2/93 pre-release
* version of rf_salsa were made by various persons
* in order to test ideas about moving/deforming meshes...
*/
{
/* Local Declarations */
double time_start, total_time; /* timing variables */
#ifndef PARALLEL
/* struct tm *tm_ptr; additional serial timing variables */
time_t now;
#endif
int error;
int i;
int j;
char **ptmp;
char *yo;
struct Command_line_command **clc=NULL; /* point to command line structure */
int nclc = 0; /* number of command line commands */
/********************** BEGIN EXECUTION ***************************************/
#ifdef FP_EXCEPT
feenableexcept ((FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID));
#endif
/* assume number of commands is less than or equal to the number of
* arguments in the command line minus 1 (1st is program name) */
/*
* Get the name of the executable, yo
*/
yo = argv[0];
#ifdef PARALLEL
MPI_Init(&argc, &argv);
time_start = MPI_Wtime();
#endif /* PARALLEL */
#ifndef PARALLEL
(void)time(&now);
time_start = (double)now;
#endif /* PARALLEL */
time_goma_started = time_start;
Argv = argv;
Argc = argc;
#ifdef PARALLEL
/*
* Determine the parallel processing status, if any. We need to know
* pretty early if we're "one of many" or the only process.
*/
error = MPI_Comm_size(MPI_COMM_WORLD, &Num_Proc);
error = MPI_Comm_rank(MPI_COMM_WORLD, &ProcID);
/*
* Setup a default Proc_config so we can use utility routines
* from Aztec
*/
AZ_set_proc_config(Proc_Config, MPI_COMM_WORLD);
/* set the output limit flag if need be */
if( Num_Proc > DP_PROC_PRINT_LIMIT ) Unlimited_Output = FALSE;
#ifdef HAVE_MPE_H
error = MPE_Init_log();
#endif /* HAVE_MPE_H */
Dim = 0; /* for any hypercube legacy code... */
#endif /* PARALLEL */
#ifndef PARALLEL
Dim = 0;
ProcID = 0;
Num_Proc = 1;
#endif /* PARALLEL */
/*
* HKM - Change the ieee exception handling based on the machine and
* the level of debugging/speed desired. This call currently causes
* core dumps for floating point exceptions.
*/
handle_ieee();
log_msg("--------------");
log_msg("GOMA begins...");
/*
* Some initial stuff that only the master process does.
*/
if ( ProcID == 0 )
{
if (argc > 1)
{
log_msg("Preprocessing command line options.");
clc = (struct Command_line_command **)
smalloc( argc * sizeof(struct Command_line_command *));
for (i=0; i<argc; i++)
{
clc[i] = (struct Command_line_command *)
smalloc(sizeof(struct Command_line_command));
clc[i]->type = 0; /* initialize command line structure */
clc[i]->i_val = 0;
clc[i]->r_val = 0.;
clc[i]->string = (char *)
smalloc(MAX_COMMAND_LINE_LENGTH*sizeof(char));
for ( j=0; j<MAX_COMMAND_LINE_LENGTH; j++)
{
clc[i]->string[j] = '\0';
}
#ifdef DEBUG
fprintf(stderr, "clc[%d]->string is at 0x%x\n", i, clc[i]->string);
fprintf(stderr, "clc[%d] is at 0x%x\n", i, clc[i]);
#endif
}
}
strcpy(Input_File, "input");
strcpy(Echo_Input_File , "echo_input");
if (argc > 1) translate_command_line(argc, argv, clc, &nclc);
ECHO("OPEN", Echo_Input_File);
echo_command_line( argc, argv, Echo_Input_File );
print_code_version();
ptmp = legal_notice;
while ( strcmp(*ptmp, LAST_LEGAL_STRING) != 0 )
{
fprintf(stderr, "%s", *ptmp++);
}
}
/*
* Allocate the uniform problem description structure and
* the problem description structures on all processors
*/
error = pd_alloc();
EH(error, "pd_alloc problem");
#ifdef DEBUG
fprintf(stderr, "P_%d at barrier after pd_alloc\n", ProcID);
#ifdef PARALLEL
error = MPI_Barrier(MPI_COMM_WORLD);
#endif
#endif
log_msg("Allocating mp, gn, ...");
error = mp_alloc();
EH(error, "mp_alloc problem");
error = gn_alloc();
EH(error, "gn_alloc problem");
error = ve_alloc();
EH(error, "ve_alloc problem");
error = elc_alloc();
EH(error, "elc_alloc problem");
error = elc_rs_alloc();
EH(error, "elc_alloc problem");
error = cr_alloc();
EH(error, "cr_alloc problem");
error = evp_alloc();
EH(error, "evp_alloc problem");
error = tran_alloc();
EH(error, "tran_alloc problem");
error = eigen_alloc();
EH(error, "eigen_alloc problem");
error = cont_alloc();
EH(error, "cont_alloc problem");
error = loca_alloc();
EH(error, "loca_alloc problem");
error = efv_alloc();
EH(error, "efv_alloc problem");
#ifdef DEBUG
fprintf(stderr, "P_%d at barrier before read_input_file()\n", ProcID);
#ifdef PARALLEL
error = MPI_Barrier(MPI_COMM_WORLD);
#endif
#endif
/*
* Read ASCII input file, data files, related exodusII FEM databases.
*/
if ( ProcID == 0 )
{
log_msg("Reading input file ...");
read_input_file(clc, nclc); /* Read ascii input file get file names */
/* update inputed data to account for command line arguments that
* might override the input deck...
*/
log_msg("Overriding any input file specs w/ any command line specs...");
if (argc > 1) apply_command_line(clc, nclc);
#ifdef DEBUG
DPRINTF(stderr, "apply_command_line() is done.\n");
#endif
}
/*
* The user-defined material properties, etc. available to goma users
* mean that some dynamically allocated data needs to be communicated.
*
* To handle this, sizing information from the input file scan is
* broadcast in stages so that the other processors can allocate space
* accordingly to hold the data.
*
* Note: instead of handpacking a data structure, use MPI derived datatypes
* to gather and scatter. Pray this is done efficiently. Certainly it costs
* less from a memory standpoint.
*/
#ifdef PARALLEL
/*
* Make sure the input file was successully processed before moving on
*/
check_parallel_error("Input file error");
/*
* This is some sizing information that helps fit a little bit more
* onto the ark later on.
*/
#ifdef DEBUG
fprintf(stderr, "P_%d at barrier before noahs_raven()\n", ProcID);
error = MPI_Barrier(MPI_COMM_WORLD);
#endif
noahs_raven();
#ifdef DEBUG
fprintf(stderr, "P_%d at barrier before MPI_Bcast of Noahs_Raven\n", ProcID);
error = MPI_Barrier(MPI_COMM_WORLD);
#endif
MPI_Bcast(MPI_BOTTOM, 1, Noahs_Raven->new_type, 0, MPI_COMM_WORLD);
#ifdef DEBUG
fprintf(stderr, "P_%d at barrier after Bcast/before raven_landing()\n",
ProcID);
error = MPI_Barrier(MPI_COMM_WORLD);
#endif
/*
* Get the other processors ready to handle ark data.
*/
raven_landing();
#ifdef DEBUG
fprintf(stderr, "P_%d at barrier before noahs_ark()\n", ProcID);
error = MPI_Barrier(MPI_COMM_WORLD);
#endif
/*
* This is the main body of communicated information, including some
* whose sizes were determined because of advanced legwork by the raven.
*/
noahs_ark();
MPI_Bcast(MPI_BOTTOM, 1, Noahs_Ark->new_type, 0, MPI_COMM_WORLD);
/*
* Chemkin was initialized on processor zero during the input file
* process. Now, distribute it to all processors
*/
#ifdef USE_CHEMKIN
if (Chemkin_Needed) {
chemkin_initialize_mp();
}
#endif
/*
* Once the ark has landed, there are additional things that will need to
* be sent by dove. Example: BC_Types[]->u-BC arrays.
*
*/
ark_landing();
noahs_dove();
MPI_Bcast(MPI_BOTTOM, 1, Noahs_Dove->new_type, 0, MPI_COMM_WORLD);
#endif /* End of ifdef PARALLEL */
/*
* We sent the packed line to all processors that contained geometry
* creation commands. Now we need to step through it and create
* geometry as we go (including possibly reading an ACIS .sat file).
*
*/
/* Check to see if BRK File option exists and if so check if file exits */
if (Brk_Flag == 1) {
check_for_brkfile(Brk_File);
}
check_parallel_error("Error encountered in check for brkfile");
/* Now break the exodus files */
if (Num_Proc > 1 && ProcID == 0 && Brk_Flag == 1) {
call_brk();
}
check_parallel_error("Error in brking exodus files");
MPI_Barrier(MPI_COMM_WORLD);
/*
* For parallel execution, assume the following variables will be changed
* to reflect the multiple file aspect of the problem.
*
* FEM file = file.exoII --> file_3of15.exoII
*
* Output EXODUS II file = out.exoII --> out_3of15.exoII
*
*/
/*
* Allocate space for structures holding the EXODUS II finite element
* database information and for the Distributed Processing information.
*
* These are mostly skeletons with pointers that get allocated in the
* rd_exoII and rd_dpi routines. Remember to free up those arrays first
* before freeing the major pointers.
*/
EXO_ptr = alloc_struct_1(Exo_DB, 1);
init_exo_struct(EXO_ptr);
DPI_ptr = alloc_struct_1(Dpi, 1);
init_dpi_struct(DPI_ptr);
log_msg("Reading mesh from EXODUS II file...");
error = read_mesh_exoII(EXO_ptr, DPI_ptr);
/*
* Missing files on any processor are detected at a lower level
* forcing a return to the higher level
* rd_exo --> rd_mesh --> main
* Shutdown now, if any of the exodus files weren't found
*/
if (error < 0) {
#ifdef PARALLEL
MPI_Finalize();
#endif
return(-1);
}
/*
* All of the MPI_Type_commit() calls called behind the scenes that build
* the dove, ark and raven really allocated memory. Let's free it up now that
* the initial information has been communicated.
*/
#ifdef PARALLEL
MPI_Type_free(&(Noahs_Raven->new_type));
MPI_Type_free(&(Noahs_Ark->new_type));
MPI_Type_free(&(Noahs_Dove->new_type));
#endif
/*
* Setup the rest of the Problem Description structure that depends on
* the mesh that was read in from the EXODUS II file...
*
* Note that memory allocation and some setup has already been performed
* in mm_input()...
*/
error = setup_pd();
EH( error, "Problem setting up Problem_Description.");
/*
* Let's check to see if we need the large elasto-plastic global tensors
* and allocate them if so
*/
error = evp_tensor_alloc(EXO_ptr);
EH( error, "Problems setting up evp tensors");
/*
* Now that we know about what kind of problem we're solving and the
* mesh information, let's allocate space for elemental assembly structures
*
*/
#ifdef DEBUG
DPRINTF(stderr, "About to assembly_alloc()...\n");
#endif
log_msg("Assembly allocation...");
error = assembly_alloc(EXO_ptr);
EH( error, "Problem from assembly_alloc");
if (Debug_Flag) {
DPRINTF(stderr, "%s: setting up EXODUS II output files...\n", yo);
}
/*
* These are not critical - just niceties. Also, they should not overburden
* your db with too much of this - they're capped verbiage compliant routines.
*/
add_qa_stamp(EXO_ptr);
add_info_stamp(EXO_ptr);
#ifdef DEBUG
fprintf(stderr, "added qa and info stamps\n");
#endif
/*
* If the output EXODUS II database file is different from the input
* file, then we'll need to replicate all the basic mesh information.
* But, remember that if we're parallel, that the output file names must
* be multiplexed first...
*/
if ( Num_Proc > 1 )
{
multiname(ExoFileOut, ProcID, Num_Proc);
multiname(Init_GuessFile, ProcID, Num_Proc);
if ( strcmp( Soln_OutFile, "" ) != 0 )
{
multiname(Soln_OutFile, ProcID, Num_Proc);
}
if( strcmp( ExoAuxFile, "" ) != 0 )
{
multiname(ExoAuxFile, ProcID, Num_Proc);
}
if( efv->Num_external_field != 0 )
{
for( i=0; i<efv->Num_external_field; i++ )
{
multiname(efv->file_nm[i], ProcID, Num_Proc);
}
}
}
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* Preprocess the exodus mesh
* -> Allocate pointers to structures containing element
* side bc info, First_Elem_Side_BC_Array, and
* element edge info, First_Elem_Edge_BC_Array.
* -> Determine Unique_Element_Types[] array
*/
#ifdef DEBUG
fprintf(stderr, "pre_process()...\n");
#endif
log_msg("Pre processing of mesh...");
#ifdef PARALLEL
error = MPI_Barrier(MPI_COMM_WORLD);
#endif
pre_process(EXO_ptr);
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* Load up a few key indeces in the bfd prototype basis function structures
* and make sure that each active eqn/vbl has a bf[v] that points to the
* right bfd[]...needs pre_process to find out the number of unique
* element types in the problem.
*/
#ifdef DEBUG
fprintf(stderr, "bf_init()...\n");
#endif
log_msg("Basis function initialization...");
error = bf_init(EXO_ptr);
EH( error, "Problem from bf_init");
/*
* check for parallel errors before continuing
*/
check_parallel_error("Error encountered in problem setup");
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* Allocate space for each communication exchange description.
*/
#ifdef PARALLEL
#ifdef DEBUG
fprintf(stderr, "P_%d: Parallel cx allocation\n", ProcID);
#endif
if (DPI_ptr->num_neighbors > 0) {
cx = alloc_struct_1(Comm_Ex, DPI_ptr->num_neighbors);
Request = alloc_struct_1(MPI_Request,
Num_Requests * DPI_ptr->num_neighbors);
Status = alloc_struct_1(MPI_Status,
Num_Requests * DPI_ptr->num_neighbors);
}
#endif
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* SET UP THE PROBLEM
*
* Setup node-based structures
* Finalise how boundary conditions are to be handled
* Determine what unknowns are at each owned node and then tell
* neighboring processors about your nodes
* Set up communications pattern for fast unknown updates between
* processors.
*/
(void) setup_problem(EXO_ptr, DPI_ptr);
/*
* check for parallel errors before continuing
*/
check_parallel_error("Error encountered in problem setup");
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* CREATE BRK_FILE IF ONE DOES NOT EXIST
*
* If no Brk_File exists but the option was configured in the input or
* optional command we create one now and exit from goma.
*/
if ( Brk_Flag == 2 ) {
write_brk_file(Brk_File, EXO_ptr);
exit(0);
}
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* WRITE OUT INITIAL INFO TO EXODUS FILE
*/
/*
* Only have to initialize the exodus file if we are using different
* files for the output versus the input mesh
*/
if (strcmp(ExoFile, ExoFileOut)) {
/*
* Temporarily we'll need to renumber the nodes and elements in the
* mesh to be 1-based. After writing, return to the 0 based indexing
* that is more convenient in C.
*/
#ifdef DEBUG
fprintf(stderr, "1-base; wr_mesh; 0-base\n");
#endif
one_base(EXO_ptr);
wr_mesh_exo(EXO_ptr, ExoFileOut, 0);
zero_base(EXO_ptr);
/*
* If running on a distributed computer, augment the plain finite
* element information of EXODUS with the description of how this
* piece fits into the global problem.
*/
if (Num_Proc > 1) {
#ifdef PARALLEL
#ifdef DEBUG
fprintf(stderr, "P_%d at barrier before wr_dpi()\n", ProcID);
fprintf(stderr, "P_%d ExoFileOut = \"%s\"\n", ProcID, ExoFileOut);
error = MPI_Barrier(MPI_COMM_WORLD);
#endif
#endif
wr_dpi(DPI_ptr, ExoFileOut, 0);
}
}
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* SOLVE THE PROBLEM
*/
if (Debug_Flag) {
switch (Continuation) {
case ALC_ZEROTH:
P0PRINTF("%s: continue_problem (zeroth order) ...\n", yo);
break;
case ALC_FIRST:
P0PRINTF("%s: continue_problem (first order) ...\n", yo);
break;
case HUN_ZEROTH:
P0PRINTF("%s: hunt_problem (zeroth order) ...\n", yo);
break;
case HUN_FIRST:
P0PRINTF("%s: hunt_problem (first order) ...\n", yo);
break;
case LOCA:
P0PRINTF("%s: do_loca ...\n", yo);
break;
default:
P0PRINTF("%s: solve_problem...\n", yo);
break;
}
}
#ifdef DEBUG
switch (Continuation) {
case ALC_ZEROTH:
DPRINTF(stderr, "%s: continue_problem (zeroth order) ...\n", yo);
break;
case ALC_FIRST:
DPRINTF(stderr, "%s: continue_problem (first order) ...\n", yo);
break;
case HUN_ZEROTH:
DPRINTF(stderr, "%s: hunt_problem (zeroth order) ...\n", yo);
break;
case HUN_FIRST:
DPRINTF(stderr, "%s: hunt_problem (first order) ...\n", yo);
break;
case LOCA:
DPRINTF(stderr, "%s: do_loca ...\n", yo);
break;
default:
DPRINTF(stderr, "%s: solve_problem...\n", yo);
break;
}
#endif
if( TimeIntegration == TRANSIENT)
{
Continuation = ALC_NONE;
if (Debug_Flag) {
P0PRINTF("%s: solve_problem...TRANSIENT superceded Continuation...\n", yo);
}
#ifdef DEBUG
DPRINTF(stderr, "%s: solve_problem...TRANSIENT superceded Continuation...\n", yo);
#endif
solve_problem(EXO_ptr, DPI_ptr, NULL);
}
switch (Continuation) {
case ALC_ZEROTH:
case ALC_FIRST:
log_msg("Solving continuation problem");
continue_problem(cx, EXO_ptr, DPI_ptr);
break;
case HUN_ZEROTH:
case HUN_FIRST:
log_msg("Solving hunt problem");
hunt_problem(cx, EXO_ptr, DPI_ptr);
break;
case LOCA:
log_msg("Solving continuation problem with LOCA");
error = do_loca(cx, EXO_ptr, DPI_ptr);
break;
default:
log_msg("Solving problem");
if (loca_in->Cont_Alg == LOCA_LSA_ONLY)
{
error = do_loca(cx, EXO_ptr, DPI_ptr);
}
else if(TimeIntegration != TRANSIENT)
{
solve_problem(EXO_ptr, DPI_ptr, NULL);
}
break;
}
#ifdef PARALLEL
MPI_Barrier(MPI_COMM_WORLD);
#endif
if (ProcID == 0 && Brk_Flag == 1 && Num_Proc > 1) {
fix_output();
}
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* PRINT A MESSAGE TO STDOUT SAYING WE ARE DONE
*/
P0PRINTF("\n-done\n\n");
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* FREE MEMORY ALLOCATED BY THE PROGRAM
*/
/*
* free the element block / element based structures
*/
free_element_blocks(EXO_ptr);
/*
* free nodal based structures
*/
free_nodes();
#ifdef FREE_PROBLEM
free_problem ( EXO_ptr, DPI_ptr );
#endif
/*
* Free command line stuff
*/
if ( ProcID == 0 )
{
if ( argc > 1 )
{
for (i=0; i<argc; i++)
{
#ifdef DEBUG
fprintf(stderr, "clc[%d]->string &= 0x%x\n", i, clc[i]->string);
fprintf(stderr, "clc[%d] &= 0x%x\n", i, clc[i]);
#endif
safer_free((void **) &(clc[i]->string));
safer_free((void **) (clc + i));
}
safer_free((void **) &clc);
}
}
/*
* Free exodus database structures
*/
free_exo(EXO_ptr);
safer_free((void **) &EXO_ptr);
if ( Num_Proc > 1 )
{
free_dpi(DPI_ptr);
}
else
{
free_dpi_uni(DPI_ptr);
}
safer_free((void **) &DPI_ptr);
/*
* Remove front scratch file [/tmp/lu.'pid'.0]
*/
if (Linear_Solver == FRONT)
{
unlerr = unlink(front_scratch_directory);
WH(unlerr, "Unlink problem with front scratch file");
}
#ifdef PARALLEL
total_time = ( MPI_Wtime() - time_start )/ 60. ;
DPRINTF(stderr, "\nProc 0 runtime: %10.2f Minutes.\n\n",total_time);
MPI_Finalize();
#endif
#ifndef PARALLEL
(void)time(&now);
total_time = (double)(now) - time_start;
fprintf(stderr, "\nProc 0 runtime: %10.2f Minutes.\n\n",total_time/60);
#endif
fflush(stdout);
fflush(stderr);
log_msg("GOMA ends normally.");
return (0);
}
void
continue_problem (Comm_Ex *cx, /* array of communications structures */
Exo_DB *exo, /* ptr to the finite element mesh database */
Dpi *dpi) /* distributed processing information */
{
int *ija=NULL; /* column pointer array */
double *a=NULL; /* nonzero array */
double *a_old=NULL; /* nonzero array */
double *x=NULL; /* solution vector */
int iAC; /* COUNTER */
double *x_AC = NULL; /* SOLUTION VECTOR OF EXTRA UNKNOWNS */
double *x_AC_old=NULL; /* old SOLUTION VECTOR OF EXTRA UNKNOWNS */
double *x_AC_dot=NULL;
int *ija_attic=NULL; /* storage for external dofs */
int eb_indx, ev_indx;
/*
* variables for path traversal
*/
double *x_old=NULL; /* old solution vector */
double *x_older=NULL; /* older solution vector */
double *x_oldest=NULL; /* oldest solution vector saved */
double *xdot=NULL; /* current path derivative of soln */
double *xdot_old=NULL;
double *x_update=NULL;
double *x_sens=NULL; /* solution sensitivity */
double *x_sens_temp=NULL; /* MMH thinks we need another one, so
* that when the solution is updated
* on a failure, it doesn't use the
* last computed x_sens b/c that might
* be crappy. We should use the last
* known good one... I haven't done
* the same thing with x_sens_p.
*/
double **x_sens_p=NULL; /* solution sensitivity for parameters */
int num_pvector=0; /* number of solution sensitivity vectors */
#ifdef COUPLED_FILL
struct Aztec_Linear_Solver_System *ams[NUM_ALSS]={NULL};
#else /* COUPLED_FILL */
struct Aztec_Linear_Solver_System *ams[NUM_ALSS]={NULL, NULL};
#endif /* COUPLED_FILL */
/* sl_util_structs.h */
double *resid_vector=NULL; /* residual */
double *resid_vector_sens=NULL;/* residual sensitivity */
double *scale=NULL; /* scale vector for modified newton */
int *node_to_fill = NULL;
int n; /* total number of path steps attempted */
int ni; /* total number of nonlinear solves */
int nt; /* total number of successful path steps */
int path_step_reform; /* counter for jacobian reformation stride */
int converged; /* success or failure of Newton iteration */
int success_ds; /* success or failure of path step */
int i, nprint=0, num_total_nodes;
int numProcUnknowns;
int const_delta_s, step_print;
double path_print, i_print;
double path, /* Current value (should have solution here) */
path1; /* New value (would like to get solution here) */
double delta_s, delta_s_new, delta_s_old, delta_s_older, delta_s_oldest;
double delta_t;
double theta=0.0;
double damp;
double eps;
double lambda, lambdaEnd;
double timeValueRead = 0.0;
/*
* ALC management variables
*/
int aldALC, /* direction of continuation, == -1 =>
beginning value is greater than ending value. */
alqALC; /* is -1 when we're on our last step. */
/*
* Other local variables
*/
int error, err, is_steady_state, inewton;
int *gindex = NULL, gsize;
int *p_gsize=NULL;
double *gvec=NULL;
double ***gvec_elem=NULL;
double err_dbl;
FILE *cl_aux=NULL, *file=NULL;
struct Results_Description *rd=NULL;
int tnv; /* total number of nodal variables and kinds */
int tev; /* total number of elem variables and kinds */
int tnv_post; /* total number of nodal variables and kinds
for post processing */
int tev_post; /* total number of elem variables and kinds
for post processing */
int iUC; /* User-defined continuation condition index */
int max_unk_elem, one, three; /* variables used as mf_setup arguments*/
unsigned int matrix_systems_mask;
double evol_local=0.0;
#ifdef PARALLEL
double evol_global=0.0;
#endif
static const char yo[]="continue_problem";
/*
* BEGIN EXECUTION
*/
#ifdef DEBUG
fprintf(stderr, "%s() begins...\n", yo);
#endif
is_steady_state = TRUE;
p_gsize = &gsize;
/*
* set aside space for gather global vectors to print to exoII file
* note: this is temporary
*
* For 2D prototype problem: allocate space for T, dx, dy arrays
*/
if( strlen(Soln_OutFile) )
{
file = fopen(Soln_OutFile, "w");
if (file == NULL) {
DPRINTF(stderr, "%s: opening soln file for writing\n", yo);
EH(-1, "\t");
}
}
#ifdef PARALLEL
check_parallel_error("Soln output file error");
#endif
/*
* Some preliminaries to help setup EXODUS II database output.
*/
#ifdef DEBUG
fprintf(stderr, "cnt_nodal_vars() begins...\n");
#endif
/*
* tnv_post is calculated in load_nodal_tkn
* tev_post is calculated in load_elem_tkn
*/
tnv = cnt_nodal_vars();
tev = cnt_elem_vars();
#ifdef DEBUG
fprintf(stderr, "Found %d total primitive nodal variables to output.\n", tnv);
fprintf(stderr, "Found %d total primitive elem variables to output.\n", tev);
#endif
if (tnv < 0)
{
DPRINTF(stderr, "%s:\tbad tnv.\n", yo);
EH(-1, "\t");
}
rd = (struct Results_Description *)
smalloc(sizeof(struct Results_Description));
if (rd == NULL)
EH(-1, "Could not grab Results Description.");
(void) memset((void *) rd, 0, sizeof(struct Results_Description));
rd->nev = 0; /* number element variables in results */
rd->ngv = 0; /* number global variables in results */
rd->nhv = 0; /* number history variables in results */
rd->ngv = 5; /* number global variables in results
see load_global_var_info for names*/
error = load_global_var_info(rd, 0, "CONV");
error = load_global_var_info(rd, 1, "NEWT_IT");
error = load_global_var_info(rd, 2, "MAX_IT");
error = load_global_var_info(rd, 3, "CONVRATE");
error = load_global_var_info(rd, 4, "MESH_VOLUME");
/* load nodal types, kinds, names */
error = load_nodal_tkn(rd,
&tnv,
&tnv_post);
if (error)
{
DPRINTF(stderr, "%s: problem with load_nodal_tkn()\n", yo);
EH(-1,"\t");
}
/* load elem types, names */
error = load_elem_tkn(rd,
exo,
tev,
&tev_post);
if (error)
{
DPRINTF(stderr, "%s: problem with load_elem_tkn()\n", yo);
EH(-1,"\t");
}
#ifdef PARALLEL
check_parallel_error("Results file error");
#endif
/*
* Write out the names of the nodal variables that we will be sending to
* the EXODUS II output file later.
*/
#ifdef DEBUG
fprintf(stderr, "wr_result_prelim() starts...\n", tnv);
#endif
gvec_elem = (double ***) smalloc ( (exo->num_elem_blocks)*sizeof(double **));
for (i = 0; i < exo->num_elem_blocks; i++)
gvec_elem[i] = (double **) smalloc ( (tev + tev_post)*sizeof(double *));
wr_result_prelim_exo(rd,
exo,
ExoFileOut,
gvec_elem );
#ifdef DEBUG
fprintf(stderr, "P_%d: wr_result_prelim_exo() ends...\n", ProcID, tnv);
#endif
/*
* This gvec workhorse transports output variables as nodal based vectors
* that are gather from the solution vector. Note: it is NOT a global
* vector at all and only carries this processor's nodal variables to
* the exodus database.
*/
asdv(&gvec, Num_Node);
/*
* Allocate space and manipulate for all the nodes that this processor
* is aware of...
*/
num_total_nodes = dpi->num_universe_nodes;
numProcUnknowns = NumUnknowns + NumExtUnknowns;
/* allocate memory for Volume Constraint Jacobian */
if ( nAC > 0)
for(iAC=0;iAC<nAC;iAC++)
augc[iAC].d_evol_dx = (double*) malloc(numProcUnknowns*sizeof(double));
asdv(&resid_vector, numProcUnknowns);
asdv(&resid_vector_sens, numProcUnknowns);
asdv(&scale, numProcUnknowns);
for (i = 0; i < NUM_ALSS; i++)
{
ams[i] = alloc_struct_1(struct Aztec_Linear_Solver_System, 1);
}
#ifdef MPI
AZ_set_proc_config( ams[0]->proc_config, MPI_COMM_WORLD );
#ifndef COUPLED_FILL
if( Explicit_Fill ) AZ_set_proc_config( ams[1]->proc_config, MPI_COMM_WORLD );
#endif /* not COUPLED_FILL */
#else /* MPI */
AZ_set_proc_config( ams[0]->proc_config, 0 );
#ifndef COUPLED_FILL
if( Explicit_Fill ) AZ_set_proc_config( ams[1]->proc_config, 0 );
#endif /* not COUPLED_FILL */
#endif /* MPI */
/*
* allocate space for and initialize solution arrays
*/
asdv(&x, numProcUnknowns);
asdv(&x_old, numProcUnknowns);
asdv(&x_older, numProcUnknowns);
asdv(&x_oldest, numProcUnknowns);
asdv(&xdot, numProcUnknowns);
asdv(&xdot_old, numProcUnknowns);
asdv(&x_update, numProcUnknowns);
asdv(&x_sens, numProcUnknowns);
asdv(&x_sens_temp, numProcUnknowns);
/*
* Initialize solid inertia flag
*/
set_solid_inertia();
/*
* FRIENDLY COMMAND LINE EQUIV
*/
if( ProcID == 0 )
{
cl_aux = fopen("goma-cl.txt", "w+");
fprintf(cl_aux, "goma -a -i input ");
fprintf(cl_aux, "-cb %10.6e ", cont->BegParameterValue);
fprintf(cl_aux, "-ce %10.6e ", cont->EndParameterValue);
fprintf(cl_aux, "-cd %10.6e ", cont->Delta_s0);
fprintf(cl_aux, "-cn %d ", cont->MaxPathSteps);
fprintf(cl_aux, "-cmin %10.6e ", cont->Delta_s_min);
fprintf(cl_aux, "-cmax %10.6e ", cont->Delta_s_max);
fprintf(cl_aux, "-cm %d ", Continuation);
fprintf(cl_aux, "-ct %d ", cont->upType);
switch (cont->upType)
{
case 1: /* BC TYPE */
fprintf(cl_aux, "-c_bc %d ", cont->upBCID);
fprintf(cl_aux, "-c_df %d ", cont->upDFID);
break;
case 2: /* MAT TYPE */
fprintf(cl_aux, "-c_mn %d ", cont->upMTID+1);
fprintf(cl_aux, "-c_mp %d ", cont->upMPID);
break;
case 3: /* AC TYPE */
fprintf(cl_aux, "-c_ac %d ", cont->upBCID);
fprintf(cl_aux, "-c_df %d ", cont->upDFID);
break;
case 4: /* USER MAT TYPE */
fprintf(cl_aux, "-c_mn %d ", cont->upMTID+1);
fprintf(cl_aux, "-c_mp %d ", cont->upMPID);
fprintf(cl_aux, "-c_md %d ", cont->upMDID);
break;
case 5: /* USER-DEFINED FUNCTION TYPE */
/* NOTE: This is not available via the command line! */
break;
case 6: /* ANGULAR CONTINUATION TYPE */
/* NOTE: This requires LOCA and is not available via the command line! */
EH(-1, "Angular continuation is available only in LOCA!");
break;
default:
fprintf(stderr, "%s: Bad cont->upType, %d\n", yo, cont->upType);
EH(-1,"Bad cont->upType");
break; /* duh */
}
fprintf(cl_aux, "\n");
fclose(cl_aux);
}
#ifdef PARALLEL
check_parallel_error("Continuation setup error");
#endif
/*
* FIRST ORDER CONTINUATION
*/
lambda = cont->BegParameterValue;
lambdaEnd = cont->EndParameterValue;
if (lambdaEnd > lambda)
aldALC = +1;
else
aldALC = -1;
delta_s_new = 0.0;
Delta_s0 = cont->Delta_s0;
Delta_s_min = cont->Delta_s_min;
Delta_s_max = cont->Delta_s_max;
MaxPathSteps = cont->MaxPathSteps;
PathMax = cont->PathMax;
eps = cont->eps;
if (Delta_s0 < 0.0 )
{
Delta_s0 = -Delta_s0;
const_delta_s = 1;
}
else
const_delta_s = 0;
damp = 1.0;
path = path1 = lambda;
if (Debug_Flag && ProcID == 0)
{
fprintf(stderr,"MaxPathSteps: %d \tlambdaEnd: %f\n", MaxPathSteps, lambdaEnd);
fprintf(stderr,"continuation in progress\n");
}
nprint = 0;
if (Delta_s0 > Delta_s_max)
Delta_s0 = Delta_s_max;
delta_s = delta_s_old = delta_s_older = Delta_s0;
delta_t = 0.0;
tran->delta_t = 0.0; /*for Newmark-Beta terms in Lagrangian Solid*/
/* Call prefront (or mf_setup) if necessary */
if (Linear_Solver == FRONT)
{
/* Also got to define these because it wants pointers to these numbers */
max_unk_elem = (MAX_PROB_VAR + MAX_CONC)*MDE;
one = 1;
three = 3;
/* NOTE: We need a overall flag in the vn_glob struct that tells whether FULL_DG
is on anywhere in domain. This assumes only one material. See sl_front_setup for test.
that test needs to be in the input parser. */
if(vn_glob[0]->dg_J_model == FULL_DG)
max_unk_elem = (MAX_PROB_VAR + MAX_CONC)*MDE + 4*vn_glob[0]->modes*4*MDE;
#ifdef PARALLEL
if (Num_Proc > 1) EH(-1, "Whoa. No front allowed with nproc>1");
check_parallel_error("Front solver not allowed with nprocs>1");
#endif
#ifdef HAVE_FRONT
err = mf_setup(&exo->num_elems,
&NumUnknowns,
&max_unk_elem,
&three,
&one,
exo->elem_order_map,
fss->el_proc_assign,
fss->level,
fss->nopdof,
fss->ncn,
fss->constraint,
front_scratch_directory,
&fss->ntra);
EH(err,"problems in frontal setup ");
#else
EH(-1,"Don't have frontal solver compiled and linked in");
#endif
}
/*
* if computing parameter sensitivities, allocate space for solution
* sensitivity vectors
*/
for(i=0;i<nn_post_fluxes_sens;i++)
{
num_pvector=MAX(num_pvector,pp_fluxes_sens[i]->vector_id);
}
for(i=0;i<nn_post_data_sens;i++)
{
num_pvector=MAX(num_pvector,pp_data_sens[i]->vector_id);
}
if((nn_post_fluxes_sens + nn_post_data_sens) > 0)
{
num_pvector++;
num_pvector = MAX(num_pvector,2);
x_sens_p = Dmatrix_birth(num_pvector,numProcUnknowns);
}
else
x_sens_p = NULL;
if (nAC > 0)
{
asdv(&x_AC, nAC);
asdv(&x_AC_old, nAC);
asdv(&x_AC_dot, nAC);
}
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterC(0, path1, x, xdot, x_AC, delta_s, cx, exo, dpi);
/* Allocate sparse matrix */
if( strcmp( Matrix_Format, "msr" ) == 0)
{
log_msg("alloc_MSR_sparse_arrays...");
alloc_MSR_sparse_arrays(&ija,
&a,
&a_old,
0,
node_to_fill,
exo,
dpi);
/*
* An attic to store external dofs column names is needed when
* running in parallel.
*/
alloc_extern_ija_buffer(num_universe_dofs,
num_internal_dofs+num_boundary_dofs,
ija, &ija_attic);
/*
* Any necessary one time initialization of the linear
* solver package (Aztec).
*/
ams[JAC]->bindx = ija;
ams[JAC]->val = a;
ams[JAC]->belfry = ija_attic;
ams[JAC]->val_old = a_old;
/*
* These point to nowhere since we're using MSR instead of VBR
* format.
*/
ams[JAC]->indx = NULL;
ams[JAC]->bpntr = NULL;
ams[JAC]->rpntr = NULL;
ams[JAC]->cpntr = NULL;
ams[JAC]->npn = dpi->num_internal_nodes + dpi->num_boundary_nodes;
ams[JAC]->npn_plus = dpi->num_internal_nodes + dpi->num_boundary_nodes + dpi->num_external_nodes;
ams[JAC]->npu = num_internal_dofs+num_boundary_dofs;
ams[JAC]->npu_plus = num_universe_dofs;
ams[JAC]->nnz = ija[num_internal_dofs+num_boundary_dofs] - 1;
ams[JAC]->nnz_plus = ija[num_universe_dofs];
}
else if( strcmp( Matrix_Format, "vbr" ) == 0)
{
log_msg("alloc_VBR_sparse_arrays...");
alloc_VBR_sparse_arrays (ams[JAC],
exo,
dpi);
ija_attic = NULL;
ams[JAC]->belfry = ija_attic;
a = ams[JAC]->val;
if( !save_old_A ) a_old = ams[JAC]->val_old = NULL;
}
else if ( strcmp( Matrix_Format, "front") == 0 )
{
/* Don't allocate any sparse matrix space when using front */
ams[JAC]->bindx = NULL;
ams[JAC]->val = NULL;
ams[JAC]->belfry = NULL;
ams[JAC]->val_old = NULL;
ams[JAC]->indx = NULL;
ams[JAC]->bpntr = NULL;
ams[JAC]->rpntr = NULL;
ams[JAC]->cpntr = NULL;
}
else
EH(-1,"Attempted to allocate unknown sparse matrix format");
init_vec(x, cx, exo, dpi, x_AC, nAC, &timeValueRead);
/* if read ACs, update data floats */
if (nAC > 0)
if(augc[0].iread == 1)
{
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi);}
}
vzero(numProcUnknowns, &x_sens[0]);
vzero(numProcUnknowns, &x_sens_temp[0]);
/*
* set boundary conditions on the initial conditions
*/
nullify_dirichlet_bcs();
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
dcopy1(numProcUnknowns,x,x_old);
dcopy1(numProcUnknowns,x_old,x_older);
dcopy1(numProcUnknowns,x_older,x_oldest);
if(nAC > 0)
dcopy1(nAC,x_AC, x_AC_old);
/*
* initialize the counters for when to print out data
*/
path_print = path1;
step_print = 1;
matrix_systems_mask = 1;
log_msg("sl_init()...");
sl_init(matrix_systems_mask, ams, exo, dpi, cx);
/*
* Make sure the solver was properly initialized on all processors.
*/
#ifdef PARALLEL
check_parallel_error("Solver initialization problems");
#endif
ams[JAC]->options[AZ_keep_info] = 1;
/*
* set the number of successful path steps to zero
*/
nt = 0;
/*
* LOOP THROUGH PARAMETER UNTIL MAX NUMBER
* OF STEPS SURPASSED
*/
for(n = 0; n < MaxPathSteps; n++)
{
alqALC = 1;
switch (aldALC)
{
case -1: /* REDUCING PARAMETER DIRECTION */
if (path1 <= lambdaEnd)
{
DPRINTF(stderr,"\n\t ******** LAST PATH STEP!\n");
alqALC = -1;
path1 = lambdaEnd;
delta_s = path-path1;
}
break;
case +1: /* RISING PARAMETER DIRECTION */
if (path1 >= lambdaEnd)
{
DPRINTF(stderr,"\n\t ******** LAST PATH STEP!\n");
alqALC = -1;
path1 = lambdaEnd;
delta_s = path1-path;
}
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
#ifdef PARALLEL
check_parallel_error("Bad aldALC");
#endif
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterC(0, path1, x, xdot, x_AC, delta_s,
cx, exo, dpi);
/*
* IF STEP CHANGED, REDO FIRST ORDER PREDICTION
*/
if(alqALC == -1)
{
dcopy1(NumUnknowns,x_old,x);
switch (Continuation)
{
case ALC_ZEROTH:
break;
case ALC_FIRST:
switch (aldALC)
{
case -1:
v1add(NumUnknowns, &x[0], -delta_s, &x_sens[0]);
break;
case +1:
v1add(NumUnknowns, &x[0], +delta_s, &x_sens[0]);
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
break;
default:
DPRINTF(stderr, "%s: Bad Continuation, %d\n", yo, Continuation);
EH(-1,"\t");
break; /* duh */
}
}
#ifdef PARALLEL
check_parallel_error("Bad Continuation");
#endif
find_and_set_Dirichlet (x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
if (ProcID == 0)
{
fprintf(stderr, "\n\t----------------------------------");
switch (Continuation)
{
case ALC_ZEROTH:
DPRINTF(stderr, "\n\tZero Order Continuation:");
break;
case ALC_FIRST:
DPRINTF(stderr, "\n\tFirst Order Continuation:");
break;
default:
DPRINTF(stderr, "%s: Bad Continuation, %d\n", yo, Continuation);
EH(-1,"\t");
break; /* duh */
}
DPRINTF(stderr, "\n\tStep number: %4d of %4d (max)", n+1, MaxPathSteps);
DPRINTF(stderr, "\n\tAttempting solution at:");
switch (cont->upType)
{
case 1: /* BC */
case 3: /* AC */
DPRINTF(stderr, "\n\tBCID=%3d DFID=%5d", cont->upBCID, cont->upDFID);
break;
case 2: /* MT */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d", cont->upMTID, cont->upMPID);
break;
case 4: /* UM */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d MDID=%3d", cont->upMTID, cont->upMPID, cont->upMDID);
break;
/* This case requires an inner switch block */
case 5: /* UF */
for (iUC=0; iUC<nUC; iUC++)
{
switch (cpuc[iUC].Type)
{
case 1: /* BC */
case 3: /* AC */
DPRINTF(stderr, "\n\tBCID=%3d DFID=%5d",
cpuc[iUC].BCID, cpuc[iUC].DFID);
break;
case 2: /* MT */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d",
cpuc[iUC].MTID, cpuc[iUC].MPID);
break;
case 4: /* UM */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d MDID=%3d",
cpuc[iUC].MTID, cpuc[iUC].MPID, cpuc[iUC].MDID);
break;
default:
DPRINTF(stderr, "%s: Bad user continuation type, %d\n",
yo, cont->upType);
EH(-1,"\t");
break;
}
DPRINTF(stderr, " Parameter= % 10.6e delta_s= %10.6e",
cpuc[iUC].value, (cpuc[iUC].value-cpuc[iUC].old_value) );
}
break;
default:
DPRINTF(stderr, "%s: Bad cont->upType, %d\n", yo, cont->upType);
EH(-1,"\t");
break; /* duh */
}
if (cont->upType != 5)
{
DPRINTF(stderr, " Parameter= % 10.6e delta_s= %10.6e", path1, delta_s);
}
}
#ifdef PARALLEL
check_parallel_error("Bad cont->upType");
#endif
ni = 0;
do {
#ifdef DEBUG
DPRINTF(stderr, "%s: starting solve_nonlinear_problem\n", yo);
#endif
err = solve_nonlinear_problem(ams[JAC],
x,
delta_t,
theta,
x_old,
x_older,
xdot,
xdot_old,
resid_vector,
x_update,
scale,
&converged,
&nprint,
tev,
tev_post,
NULL,
rd,
gindex,
p_gsize,
gvec,
gvec_elem,
path1,
exo,
dpi,
cx,
0,
&path_step_reform,
is_steady_state,
x_AC,
x_AC_dot,
path1,
resid_vector_sens,
x_sens_temp,
x_sens_p,
NULL);
#ifdef DEBUG
fprintf(stderr, "%s: returned from solve_nonlinear_problem\n", yo);
#endif
if (err == -1)
converged = 0;
inewton = err;
if (converged)
{
if (Write_Intermediate_Solutions == 0) {
#ifdef DEBUG
DPRINTF(stderr, "%s: write_solution call WIS\n", yo);
#endif
write_solution(ExoFileOut, resid_vector, x, x_sens_p,
x_old, xdot, xdot_old, tev, tev_post, NULL, rd,
gindex, p_gsize, gvec, gvec_elem, &nprint,
delta_s, theta, path1, NULL, exo, dpi);
#ifdef DEBUG
fprintf(stderr, "%s: write_solution end call WIS\n", yo);
#endif
}
#ifdef PARALLEL
check_parallel_error("Error writing exodusII file");
#endif
/*
* PRINT OUT VALUES OF EXTRA UNKNOWNS
* FROM AUGMENTING CONDITIONS
*/
if (nAC > 0)
{
DPRINTF(stderr, "\n------------------------------\n");
DPRINTF(stderr, "Augmenting Conditions: %4d\n", nAC);
DPRINTF(stderr, "Number of extra unknowns: %4d\n\n", nAC);
for (iAC = 0; iAC < nAC; iAC++)
{
if (augc[iAC].Type == AC_USERBC)
{
DPRINTF(stderr, "\tBC[%4d] DF[%4d] = %10.6e\n",
augc[iAC].BCID, augc[iAC].DFID, x_AC[iAC]);
}
else if (augc[iAC].Type == AC_USERMAT ||
augc[iAC].Type == AC_FLUX_MAT )
{
DPRINTF(stderr, "\tMT[%4d] MP[%4d] = %10.6e\n",
augc[iAC].MTID, augc[iAC].MPID, x_AC[iAC]);
}
else if(augc[iAC].Type == AC_VOLUME)
{
evol_local = augc[iAC].evol;
#ifdef PARALLEL
if( Num_Proc > 1 ) {
MPI_Allreduce( &evol_local, &evol_global, 1,
MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
evol_local = evol_global;
#endif
DPRINTF(stderr, "\tMT[%4d] VC[%4d]=%10.6e Param=%10.6e\n",
augc[iAC].MTID, augc[iAC].VOLID, evol_local,
x_AC[iAC]);
}
else if(augc[iAC].Type == AC_POSITION)
{
evol_local = augc[iAC].evol;
#ifdef PARALLEL
if( Num_Proc > 1 ) {
MPI_Allreduce( &evol_local, &evol_global, 1,
MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
evol_local = evol_global;
#endif
DPRINTF(stderr, "\tMT[%4d] XY[%4d]=%10.6e Param=%10.6e\n",
augc[iAC].MTID, augc[iAC].VOLID, evol_local,
x_AC[iAC]);
}
else if(augc[iAC].Type == AC_FLUX)
{
DPRINTF(stderr, "\tBC[%4d] DF[%4d]=%10.6e\n",
augc[iAC].BCID, augc[iAC].DFID, x_AC[iAC]);
}
}
}
/*
* INTEGRATE FLUXES, FORCES
*/
for (i = 0; i < nn_post_fluxes; i++)
err_dbl = evaluate_flux (exo, dpi,
pp_fluxes[i]->ss_id,
pp_fluxes[i]->flux_type ,
pp_fluxes[i]->flux_type_name ,
pp_fluxes[i]->blk_id ,
pp_fluxes[i]->species_number,
pp_fluxes[i]->flux_filenm,
pp_fluxes[i]->profile_flag,
x,xdot,NULL, delta_s,path1,1);
/*
* COMPUTE FLUX, FORCE SENSITIVITIES
*/
for (i = 0; i < nn_post_fluxes_sens; i++)
err_dbl = evaluate_flux_sens (exo, dpi,
pp_fluxes_sens[i]->ss_id,
pp_fluxes_sens[i]->flux_type ,
pp_fluxes_sens[i]->flux_type_name ,
pp_fluxes_sens[i]->blk_id ,
pp_fluxes_sens[i]->species_number,
pp_fluxes_sens[i]->sens_type,
pp_fluxes_sens[i]->sens_id,
pp_fluxes_sens[i]->sens_flt,
pp_fluxes_sens[i]->sens_flt2,
pp_fluxes_sens[i]->vector_id,
pp_fluxes_sens[i]->flux_filenm,
pp_fluxes_sens[i]->profile_flag,
x,xdot,x_sens_p,delta_s,path1,1);
/*
* Compute global volumetric quantities
*/
for (i = 0; i < nn_volume; i++ ) {
evaluate_volume_integral(exo, dpi,
pp_volume[i]->volume_type,
pp_volume[i]->volume_name,
pp_volume[i]->blk_id,
pp_volume[i]->species_no,
pp_volume[i]->volume_fname,
pp_volume[i]->params,
NULL, x, xdot, delta_s,
path1, 1);
}
} /* end of if converged block */
/*
* INCREMENT COUNTER
*/
ni++;
/*
* DID IT CONVERGE ?
* IF NOT, REDUCE STEP SIZE AND TRY AGAIN
*/
if (!converged)
{
if (ni > 5)
{
puts(" ");
puts(" ************************************");
puts(" W: Did not converge in Newton steps.");
puts(" Find better initial guess. ");
puts(" ************************************");
/* This needs to have a return value of 0, indicating
* success, for the continuation script to not treat this
* as a failed command. */
exit(0);
}
/*
* ADJUST STEP SIZE
*/
DPRINTF(stderr, "\n\tFailed to converge:\n");
delta_s *= 0.5;
switch (aldALC)
{
case -1:
path1 = path - delta_s;
break;
case +1:
path1 = path + delta_s;
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
#ifdef PARALLEL
check_parallel_error("Bad aldALC");
#endif
/*
* RESET
*/
alqALC = 1; /* If necessary, don't call this the last step... */
DPRINTF(stderr, "\n\tDecreasing step-length to %10.6e.\n", delta_s);
if (delta_s < Delta_s_min)
{
puts("\n X: C step-length reduced below minimum.");
puts("\n Program terminated.\n");
/* This needs to have a return value of 0, indicating
* success, for the continuation script to not treat this
* as a failed command. */
exit(0);
}
#ifdef PARALLEL
check_parallel_error("\t");
#endif
/*
* ADJUST NATURAL PARAMETER
*/
dcopy1(numProcUnknowns, x_old, x);
update_parameterC(0, path1, x, xdot, x_AC, delta_s,
cx, exo, dpi);
/*
* GET ZERO OR FIRST ORDER PREDICTION
*/
switch (Continuation)
{
case ALC_ZEROTH:
break;
case ALC_FIRST:
switch (aldALC)
{
case -1:
v1add(numProcUnknowns, &x[0], -delta_s, &x_sens[0]);
break;
case +1:
v1add(numProcUnknowns, &x[0], +delta_s, &x_sens[0]);
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
break;
default:
DPRINTF(stderr, "%s: Bad Continuation, %d\n", yo, Continuation);
EH(-1,"\t");
break; /* duh */
}
#ifdef PARALLEL
check_parallel_error("Bad Continuation");
#endif
/* MMH: Needed to put this in, o/w it may find that the
* solution and residual HAPPEN to satisfy the convergence
* criterion for the next newton solve...
*/
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
/* Should be doing first order prediction on ACs
* but for now, just reset the AC variables
*/
if( nAC > 0)
{
dcopy1(nAC, x_AC_old, x_AC);
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi);}
}
} /* end of !converged */
} while (converged == 0);
/*
* CONVERGED
*/
nt++;
if( Continuation == ALC_ZEROTH ) {
DPRINTF(stderr, "\n\tStep accepted, parameter = %10.6e\n", path1);
}
else {
DPRINTF(stderr, "\tStep accepted, parameter = %10.6e\n", path1);
}
/*
* check path step error, if too large do not enlarge path step
*/
if ((ni == 1) && (n != 0) && (!const_delta_s))
{
delta_s_new = path_step_control(num_total_nodes,
delta_s, delta_s_old,
x,
eps,
&success_ds,
cont->use_var_norm, inewton);
if (delta_s_new > Delta_s_max)
delta_s_new = Delta_s_max;
}
else
{
success_ds = 1;
delta_s_new = delta_s;
}
/*
* determine whether to print out the data or not
*/
i_print = 0;
if (nt == step_print)
{
i_print = 1;
step_print += cont->print_freq;
}
if (alqALC == -1)
i_print = 1;
if (i_print)
{
error = write_ascii_soln(x, resid_vector, numProcUnknowns,
x_AC, nAC, path1, file);
if (error) {
DPRINTF(stdout, "%s: error writing ASCII soln file\n", yo);
}
if (Write_Intermediate_Solutions == 0 ) {
write_solution(ExoFileOut, resid_vector, x, x_sens_p,
x_old, xdot, xdot_old, tev, tev_post, NULL,
rd, gindex, p_gsize, gvec, gvec_elem, &nprint,
delta_s, theta, path1, NULL, exo, dpi);
nprint++;
}
}
/*
* backup old solutions
* can use previous solutions for prediction one day
*/
dcopy1(numProcUnknowns,x_older,x_oldest);
dcopy1(numProcUnknowns,x_old,x_older);
dcopy1(numProcUnknowns, x, x_old);
dcopy1(numProcUnknowns, x_sens_temp, x_sens);
delta_s_oldest = delta_s_older;
delta_s_older = delta_s_old;
delta_s_old = delta_s;
delta_s = delta_s_new;
if( nAC > 0)
dcopy1(nAC, x_AC, x_AC_old);
/*
* INCREMENT/DECREMENT PARAMETER
*/
path = path1;
switch (aldALC)
{
case -1:
path1 = path - delta_s;
break;
case +1:
path1 = path + delta_s;
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
#ifdef PARALLEL
check_parallel_error("Bad aldALC");
#endif
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterC(0, path1, x, xdot, x_AC, delta_s,
cx, exo, dpi);
/*
display_parameterC(path1, x, xdot, delta_s,
cx, exo, dpi);
*/
/*
* GET FIRST ORDER PREDICTION
*/
switch (Continuation)
{
case ALC_ZEROTH:
break;
case ALC_FIRST:
switch (aldALC)
{
case -1:
v1add(numProcUnknowns, &x[0], -delta_s, &x_sens[0]);
break;
case +1:
v1add(numProcUnknowns, &x[0], +delta_s, &x_sens[0]);
break;
default:
DPRINTF(stderr, "%s: Bad aldALC, %d\n", yo, aldALC);
EH(-1,"\t");
break; /* duh */
}
break;
}
#ifdef PARALLEL
check_parallel_error("Bad aldALC");
#endif
/*
* CHECK END CONTINUATION
*/
/*
if (alqALC == -1)
alqALC = 0;
else
alqALC = 1;
*/
if (alqALC == -1)
{
DPRINTF(stderr,"\n\n\t I will continue no more!\n\t No more continuation for you!\n");
goto free_and_clear;
}
} /* for(n = 0; n < MaxPathSteps; n++) */
if(n == MaxPathSteps &&
aldALC * (lambdaEnd - path) > 0)
{
DPRINTF(stderr, "\n\tFailed to reach end of hunt in maximum number of successful steps (%d).\n\tSorry.\n",
MaxPathSteps);
/*
EH(-1,"\t");
*/
}
#ifdef PARALLEL
check_parallel_error("Continuation error");
#endif
/*
* DONE CONTINUATION
*/
free_and_clear:
/*
* Transform the node point coordinates according to the
* displacements and write out all the results using the
* displaced coordinates. Set the displacement field to
* zero, too.
*/
if (Anneal_Mesh)
{
#ifdef DEBUG
fprintf(stderr, "%s: anneal_mesh()...\n", yo);
#endif
err = anneal_mesh(x, tev, tev_post, NULL, rd, path1, exo, dpi);
#ifdef DEBUG
fprintf(stderr, "%s: anneal_mesh()-done\n", yo);
#endif
EH(err, "anneal_mesh() bad return.");
}
#ifdef PARALLEL
check_parallel_error("Trouble annealing mesh");
#endif
/*
* Free a bunch of variables that aren't needed anymore
*/
safer_free((void **) &ROT_Types);
safer_free((void **) &node_to_fill);
safer_free( (void **) &resid_vector);
safer_free( (void **) &resid_vector_sens);
safer_free( (void **) &scale);
safer_free( (void **) &x);
if (nAC > 0)
{
safer_free( (void **) &x_AC);
safer_free( (void **) &x_AC_old);
safer_free( (void **) &x_AC_dot);
}
safer_free( (void **) &x_old);
safer_free( (void **) &x_older);
safer_free( (void **) &x_oldest);
safer_free( (void **) &xdot);
safer_free( (void **) &xdot_old);
safer_free( (void **) &x_update);
safer_free( (void **) &x_sens);
safer_free( (void **) &x_sens_temp);
if((nn_post_data_sens+nn_post_fluxes_sens) > 0)
Dmatrix_death(x_sens_p,num_pvector,numProcUnknowns);
for(i = 0; i < MAX_NUMBER_MATLS; i++) {
for(n = 0; n < MAX_MODES; n++) {
safer_free((void **) &(ve_glob[i][n]->gn));
safer_free((void **) &(ve_glob[i][n]));
}
safer_free((void **) &(vn_glob[i]));
}
sl_free(matrix_systems_mask, ams);
for (i = 0; i < NUM_ALSS; i++)
safer_free((void **) &(ams[i]));
safer_free( (void **) &gvec);
i = 0;
for ( eb_indx = 0; eb_indx < exo->num_elem_blocks; eb_indx++ )
{
for ( ev_indx = 0; ev_indx < rd->nev; ev_indx++ ) {
if (exo->elem_var_tab[i++] == 1) {
safer_free((void **) &(gvec_elem [eb_indx][ev_indx]));
}
}
safer_free((void **) &(gvec_elem [eb_indx]));
}
safer_free( (void **) &gvec_elem);
if (cpcc != NULL) safer_free( (void **) &cpcc);
safer_free( (void **) &rd);
safer_free( (void **) &Local_Offset);
safer_free( (void **) &Dolphin);
if (file != NULL) fclose(file);
return;
} /* END of routine continue_problem */
void
bc_matrl_index(Exo_DB *exo)
/********************************************************************
*
* bc_matrl_index():
*
* Find out what materials are on each side of a boundary
* condition. Note, some boundary conditions require one
* to specify this information in the form of an element block
* id. However, some others do not. This procedure attempts to
* calculate this for all boundary conditions and then fill in
* the BC_matrl_index_# elements of the Boundary_Condition
* structure.
*
* The basic algorithm involves finding some information about
* the side or node set on which the boundary condition is
* applied. Then, given the bc name and this information,
* a decision is made as to what the BC_matrl_index_#'s should be
* set to.
*
* We gather the following information to make this decision:
* 1) element block indecises input from deck
* 2) Number of nodes in the bc set in each material
* 3) Number of elements, whoses sides are in the side set,
* in each material
* 4) Node in the bc set which contains the minimum
* number of materials
* 5) Node in the bc set which contains the maximum
* number of materials
* 6) A random node in the bc set which contains a
* specific number of materials (1, 2, 3, 4)
*
*
* HKM NOTE:
* This routine is a work in progress. Calculation of EDGE's and
* VERTICES are not done yet. Also, mp aspects haven't been
* figured out yet.
*
*******************************************************************/
{
int ibc, ss_index, side_index, k, node_num, i;
int i_apply_meth, num_matrl_needed = -1;
int found = FALSE, min_node_matrl, max_node_matrl, min_matrl,
max_matrl, node_matrl_1, node_matrl_2, node_matrl_3,
node_matrl_4, matrl_first;
int *bin_matrl, *ind_matrl, *bin_matrl_elem,
*node_flag_1ss, node_count;
int mat_index, success, ielem;
NODE_INFO_STRUCT *node_ptr;
UMI_LIST_STRUCT *matrlLP;
struct Boundary_Condition *bc_ptr;
static char *yo = "bc_matrl_index :";
bin_matrl = alloc_int_1(upd->Num_Mat * 4, INT_NOINIT);
ind_matrl = bin_matrl + upd->Num_Mat;
bin_matrl_elem = ind_matrl + upd->Num_Mat;
node_flag_1ss = alloc_int_1(exo->num_nodes, INT_NOINIT);
for (ibc = 0; ibc < Num_BC; ibc++) {
bc_ptr = BC_Types + ibc;
found = FALSE;
/*
* Some boundary condition specifications already require
* you to specify the element blocks on either side of the
* side set.
*/
switch (bc_ptr->BC_Name) {
/*
* For these boundary conditions, the element block ID numbers
* are in the firest two integer slots
*/
case POROUS_PRESSURE_BC:
case DARCY_CONTINUOUS_BC:
case Y_DISCONTINUOUS_BC:
case POROUS_GAS_BC:
case VP_EQUIL_BC:
case VN_POROUS_BC:
case FLUID_SOLID_BC:
case SOLID_FLUID_BC:
case NO_SLIP_BC:
case FLUID_SOLID_CONTACT_BC:
case SOLID_FLUID_CONTACT_BC:
case T_CONTACT_RESIS_BC:
case T_CONTACT_RESIS_2_BC:
case LIGHTP_JUMP_BC:
case LIGHTM_JUMP_BC:
case LIGHTP_JUMP_2_BC:
case LIGHTM_JUMP_2_BC:
bc_ptr->BC_matrl_index_1 = map_mat_index(bc_ptr->BC_Data_Int[0]);
bc_ptr->BC_matrl_index_2 = map_mat_index(bc_ptr->BC_Data_Int[1]);
break;
/*
* For this boundary condition the element block numbers
* are in the second and third integer slots
*/
case VL_EQUIL_BC:
case YFLUX_DISC_RXN_BC:
case DISCONTINUOUS_VELO_BC:
bc_ptr->BC_matrl_index_1 = map_mat_index(bc_ptr->BC_Data_Int[1]);
bc_ptr->BC_matrl_index_2 = map_mat_index(bc_ptr->BC_Data_Int[2]);
break;
}
/*
* Initialize quantities
*/
for (i = 0; i < 4 * upd->Num_Mat; i++) bin_matrl[i] = 0;
for (i = 0; i < exo->num_nodes; i++) node_flag_1ss[i] = 0;
max_node_matrl = min_node_matrl = -1;
min_matrl = 4000000;
max_matrl = -1;
node_matrl_1 = node_matrl_2 = node_matrl_3 = node_matrl_4 = -1;
/*
* Determine how many materials each boundary condition needs
* based on the type of the boundary condition
*/
i_apply_meth = BC_Types[ibc].desc->i_apply;
if (i_apply_meth == CROSS_PHASE_DISCONTINUOUS ||
i_apply_meth == CROSS_PHASE) {
num_matrl_needed = 2;
} else if (i_apply_meth == SINGLE_PHASE) {
num_matrl_needed = 1;
}
/*
* Loop over the nodes in the side set looking up what
* materials are located at each node
* -> this will work for side sets. Need to do node sets
* as well.
*/
if (!strcmp(bc_ptr->Set_Type, "SS")) {
for (ss_index = 0; ss_index < exo->num_side_sets; ss_index++) {
/*
* This logic works for one side set specifications. For
* two side set specifications (EDGES), we will have to go
* with a calculation of the union of side sets.
*/
if (bc_ptr->BC_ID == exo->ss_id[ss_index]) {
found = TRUE;
for (side_index = 0;
side_index < exo->ss_num_sides[ss_index];
side_index++) {
/*
* Locate the element number, find the material index,
* then bin the result.
*/
ielem = exo->ss_elem_list[exo->ss_elem_index[ss_index]+side_index];
mat_index = find_mat_number(ielem, exo);
bin_matrl_elem[mat_index]++;
for (k = exo->ss_node_side_index[ss_index][side_index];
k < exo->ss_node_side_index[ss_index][side_index+1];
k++) {
node_num = exo->ss_node_list[ss_index][k];
if (!node_flag_1ss[node_num]) {
node_flag_1ss[node_num] = 1;
node_ptr = Nodes[node_num];
matrlLP = &(node_ptr->Mat_List);
/*
* Bin the materials at this node for later usage.
*/
for (i = 0; i < matrlLP->Length; i++) {
#ifdef DEBUG_IGNORE_ELEMENT_BLOCK_CAPABILITY
if (matrlLP->List[i] < 0) {
fprintf(stderr,"Material list contains negative number\n");
EH(-1,"logic error in ignoring an element block");
}
#endif
bin_matrl[matrlLP->List[i]]++;
}
/*
* Find the max and min number of materials for a
* node in this side set
*/
if (matrlLP->Length > max_matrl) {
max_matrl = matrlLP->Length;
max_node_matrl = node_num;
}
if (matrlLP->Length < min_matrl) {
min_matrl = matrlLP->Length;
min_node_matrl = node_num;
}
/*
* Find representative nodes with specific
* numbers of materials
*/
if (matrlLP->Length == 1) node_matrl_1 = node_num;
if (matrlLP->Length == 2) node_matrl_2 = node_num;
if (matrlLP->Length == 3) node_matrl_3 = node_num;
if (matrlLP->Length == 4) node_matrl_4 = node_num;
}
}
}
}
} /* End of side set loop */
} /* if SS */
/*
* Node Sets
*/
if (!strcmp(bc_ptr->Set_Type, "NS")) {
for (ss_index = 0; ss_index < exo->num_node_sets; ss_index++) {
/*
* This logic works for one side set specifications. For
* two side set specifications (EDGES), we will have to go
* with a calculation of the union of side sets.
*/
if (bc_ptr->BC_ID == exo->ns_id[ss_index]) {
found = TRUE;
/*
* Loop over the number of nodes
*/
for (k = 0; k < exo->ns_num_nodes[ss_index]; k++) {
node_num = exo->ns_node_list[exo->ns_node_index[ss_index]+k];
if (!node_flag_1ss[node_num]) {
node_flag_1ss[node_num] = 1;
node_ptr = Nodes[node_num];
matrlLP = &(node_ptr->Mat_List);
/*
* Bin the materials at this node for later usage.
*/
for (i = 0; i < matrlLP->Length; i++) {
bin_matrl[matrlLP->List[i]]++;
}
/*
* Find the max and min number of materials for a
* node in this side set
*/
if (matrlLP->Length > max_matrl) {
max_matrl = matrlLP->Length;
max_node_matrl = node_num;
}
if (matrlLP->Length < min_matrl) {
min_matrl = matrlLP->Length;
min_node_matrl = node_num;
}
/*
* Find representative nodes with specific
* numbers of materials
*/
if (matrlLP->Length == 1) node_matrl_1 = node_num;
if (matrlLP->Length == 2) node_matrl_2 = node_num;
if (matrlLP->Length == 3) node_matrl_3 = node_num;
if (matrlLP->Length == 4) node_matrl_4 = node_num;
}
}
}
} /* End of side set loop */
} /* if NS */
/*
* Ok, we have obtained statistics on the side and node sets
* let's make a decision
*/
if (found) {
matrl_first = find_next_max(bin_matrl, ind_matrl, upd->Num_Mat);
success = assign_matrl_2(bc_ptr, matrl_first);
if (success < 0) {
printf("%s P_%d: problem in assigning first matrl index in ibc %d, %d:\n",
yo, ProcID, ibc, matrl_first);
bc_matrl_index_print(bc_ptr, bin_matrl, bin_matrl_elem,
min_node_matrl, max_node_matrl,
node_matrl_1, node_matrl_2, node_matrl_3,
node_matrl_4, ibc);
}
matrl_first = find_next_max(bin_matrl, ind_matrl, upd->Num_Mat);
if (matrl_first >= 0) {
success = assign_matrl_2(bc_ptr, matrl_first);
if (success < 0) {
printf("%s P_%d: problem in assigning second matrl index in ibc %d, %d:\n",
yo, ProcID, ibc, matrl_first);
bc_matrl_index_print(bc_ptr, bin_matrl, bin_matrl_elem,
min_node_matrl, max_node_matrl,
node_matrl_1, node_matrl_2, node_matrl_3,
node_matrl_4, ibc);
}
} else {
if (num_matrl_needed > 1) {
printf("%s P_%d: problem in finding a needed second matrl index:\n",
yo, ProcID);
EH(-1,"bc_matrl_index ERROR");
}
}
}
/*
* For debug purposes, print out everything that we have found
* out and decided about this bc on all of the processors.
*/
#ifdef DEBUG_HKM
print_sync_start(FALSE);
bc_matrl_index_print(bc_ptr, bin_matrl, bin_matrl_elem,
min_node_matrl, max_node_matrl,
node_matrl_1, node_matrl_2, node_matrl_3,
node_matrl_4, ibc);
print_sync_end(FALSE);
#endif
/*
* MP Fix: We may not get the same results on all processors
* In this case, just take the processor with the most
* nodes in this bc and with a valid result, and use
* that. Broadcast that result to all nodes. Cross your
* fingers.
*/
node_count = 0;
for (i = 0; i < exo->num_nodes; i++) {
node_count += node_flag_1ss[i];
}
#ifdef PARALLEL
k = ProcWithMaxInt(node_count, &i);
MPI_Bcast(&(bc_ptr->BC_matrl_index_1), 1, MPI_INT, k,
MPI_COMM_WORLD);
MPI_Bcast(&(bc_ptr->BC_matrl_index_2), 1, MPI_INT, k,
MPI_COMM_WORLD);
MPI_Bcast(&(bc_ptr->BC_matrl_index_3), 1, MPI_INT, k,
MPI_COMM_WORLD);
MPI_Bcast(&(bc_ptr->BC_matrl_index_4), 1, MPI_INT, k,
MPI_COMM_WORLD);
#ifdef DEBUG_HKM
print_sync_start(FALSE);
if ( !ProcID ) {
printf("Final matrl_index's for ibc = %d:\n", ibc);
printf("\tBC_matrl_index_1 = %d\n", bc_ptr->BC_matrl_index_1);
printf("\tBC_matrl_index_2 = %d\n", bc_ptr->BC_matrl_index_2);
printf("\tBC_matrl_index_3 = %d\n", bc_ptr->BC_matrl_index_3);
printf("\tBC_matrl_index_4 = %d\n", bc_ptr->BC_matrl_index_4);
fflush(stdout);
}
print_sync_end(FALSE);
#endif
#endif
}
safer_free((void **) &bin_matrl);
safer_free((void **) &node_flag_1ss);
}
int
coordinate_discontinuous_variables(Exo_DB *exo, Dpi *dpi)
/********************************************************************
*
* coordinate_discontinuous_variables():
*
* -> Make sure we have the correct designations for the v field
* in the problem description structure for each material.
*
* -> Make sure that we have the same v field for all material
* types on all processors.
*
*
*******************************************************************/
{
int ibc, eqn_type, ss_index, side_index, k, node_num, imat;
int num_mat, mat_index, var_type, *ivec;
UMI_LIST_STRUCT *curr_mat_list;
NODE_INFO_STRUCT *node_ptr;
PROBLEM_DESCRIPTION_STRUCT *curr_pd;
/*
* Loop over the boundary conditions. If we have a cross
* phase discontinuous boundary condition, then we need to set the
* v field for the appropriate variable types on both sides of the
* interface to denote a discontinuous interpolation at the
* interface.
*/
for (ibc = 0; ibc < Num_BC; ibc++) {
if (BC_Types[ibc].desc->i_apply == CROSS_PHASE_DISCONTINUOUS) {
eqn_type = BC_Types[ibc].desc->equation;
/*
* If we are applying a bc on the momentum equations
* let's assign it a base equation type
*/
if (eqn_type == R_MOMENTUM1 || eqn_type == R_MOMENTUM2 ||
eqn_type == R_MOMENTUM3 ||
eqn_type == R_MOM_NORMAL || eqn_type == R_MOM_TANG1 ||
eqn_type == R_MOM_TANG2 ) {
eqn_type = R_MOMENTUM1;
}
/*
* If we are applying a discontinuous bc on one species
* equation, then we must apply it to all species equations.
*/
if (eqn_type == R_MASS ||
(eqn_type >= R_SPECIES_UNK_0 && eqn_type <= R_SPECIES_UNK_LAST)
) {
eqn_type = R_SPECIES_UNK_0;
}
for (ss_index = 0; ss_index < exo->num_side_sets; ss_index++) {
if (BC_Types[ibc].BC_ID == exo->ss_id[ss_index]) {
for (side_index = 0; side_index < exo->ss_num_sides[ss_index];
side_index++) {
for (k = exo->ss_node_side_index[ss_index][side_index];
k < exo->ss_node_side_index[ss_index][side_index+1]; k++) {
node_num = exo->ss_node_list[ss_index][k];
node_ptr = Nodes[node_num];
curr_mat_list = &(node_ptr->Mat_List);
num_mat = curr_mat_list->Length;
/*
* Now make sure that we have the discontinuous var turned
* on
*/
for (imat = 0; imat < num_mat; imat++) {
mat_index= (curr_mat_list->List)[imat];
curr_pd = pd_glob[mat_index];
if (eqn_type == R_MOMENTUM1) {
turn_on_discontinuous(curr_pd, R_MOMENTUM1);
turn_on_discontinuous(curr_pd, R_MOMENTUM2);
turn_on_discontinuous(curr_pd, R_MOMENTUM3);
turn_on_discontinuous(curr_pd, PRESSURE);
} else if (eqn_type == R_SPECIES_UNK_0) {
turn_on_discontinuous(curr_pd, R_MASS);
for (var_type = R_SPECIES_UNK_0;
var_type < R_SPECIES_UNK_LAST; var_type++) {
turn_on_discontinuous(curr_pd, var_type);
}
} else {
turn_on_discontinuous(curr_pd, eqn_type);
}
}
}
}
}
}
}
}
/*
* Just to dot the eyes, make sure that v fields are uniform on
* distributed processor problems. We will use the MPI_BOR
* operation on a Reduce operation to processor zero, followed
* by a broadcast from zero, to accomplish this.
*/
#ifdef PARALLEL
ivec = alloc_int_1(V_LAST, 0);
for (imat = 0; imat < upd->Num_Mat; imat++) {
curr_pd = pd_glob[imat];
for (k = 0; k < V_LAST; k++) {
ivec[k] = curr_pd->v[k];
}
ReduceBcast_BOR(ivec, V_LAST);
#ifdef DEBUG_HKM
print_sync_start(TRUE);
for (k = 0; k < V_LAST; k++) {
if (curr_pd->v[k] != ivec[k]) {
printf("P_%d: v field for var_type %d changed from %d to %d\n",
ProcID, k, curr_pd->v[k], ivec[k]);
}
}
print_sync_end(TRUE);
#endif
for (k = 0; k < V_LAST; k++) {
curr_pd->v[k] = ivec[k];
}
}
safer_free((void **) &ivec);
#endif
return 0;
}
void
setup_external_nodal_matrls(Exo_DB *exo, Dpi *dpi, Comm_Ex *cx)
/************************************************************************
*
* setup_external_nodal_matrls():
*
* This routine exchanges information about the materials
* from each owned node to each ghost node. We first pack the information
* about the solution vector on each owned node on this current
* processor into a compact form. Then, we use the normal exchange
* node information routine to exchange this information with the
* neighboring processors.
* Then, we unpack the information obtained from neighboring
* processors into nodal variable structures. And, then we use
* the same procedure that we used in setup_local_nodal_vars() to
* assign nodal var structures to external nodes.
* At the end of this procedure, we are assured that ghost nodes will
* have the same picture of the solution vector as owned nodes.
*
************************************************************************/
{
int i, k, p, node_num, max_Matrl;
int *mesg_send = NULL, *mesg_recv = NULL, *istart;
NODE_INFO_STRUCT *node;
COMM_NP_STRUCT *np_ptr, *np_base = NULL;
/*
* Find out the maximum number of materials per node
*/
max_Matrl = find_MaxMatrlPerNode();
/*
* Pack information for sending
*/
if (dpi->num_neighbors > 0) {
mesg_send = alloc_int_1(ptr_node_send[dpi->num_neighbors] * max_Matrl, -1);
mesg_recv = alloc_int_1(ptr_node_recv[dpi->num_neighbors] * max_Matrl, -1);
for (i = 0; i < ptr_node_send[dpi->num_neighbors]; i++) {
node_num = list_node_send[i];
node = Nodes[node_num];
istart = mesg_send + i*max_Matrl;
for (k = 0; k < node->Mat_List.Length; k++) {
istart[k] = node->Mat_List.List[k];
}
}
np_base = alloc_struct_1(COMM_NP_STRUCT, dpi->num_neighbors);
}
np_ptr = np_base;
for (p = 0; p < dpi->num_neighbors; p++) {
np_ptr->neighbor_ProcID = cx[p].neighbor_name;
np_ptr->send_message_buf =
(void *) (mesg_send + ptr_node_send[p] * max_Matrl);
np_ptr->send_message_length =
sizeof(int) * cx[p].num_nodes_send * max_Matrl;
np_ptr->recv_message_buf =
(void *) (mesg_recv + ptr_node_recv[p] * max_Matrl);
np_ptr->recv_message_length =
sizeof(int) * cx[p].num_nodes_recv * max_Matrl;
np_ptr++;
}
exchange_neighbor_proc_info(dpi->num_neighbors, np_base);
#ifdef DEBUG_HKM
printf("P_%d at barrier after exchange in setup_external_nodal_matrls\n",
ProcID); fflush(stdout);
#ifdef PARALLEL
MPI_Barrier(MPI_COMM_WORLD);
#endif
#endif
for (i = 0; i < dpi->num_external_nodes; i++) {
node_num = dpi->num_internal_nodes + dpi->num_boundary_nodes + i;
node = Nodes[node_num];
istart = mesg_recv + i*max_Matrl;
/*
* Unpack ther materials and then add them to the existing
* list.
*/
for (k = 0; k < max_Matrl; k++) {
if (istart[k] != -1) {
add_to_umi_int_list(&(node->Mat_List), istart[k]);
} else {
break;
}
}
}
#ifdef DEBUG_HKM
if ((k = find_MaxMatrlPerNode()) != max_Matrl) {
printf("ERROR! %d %d\n", max_Matrl, k);
exit (-1);
}
#endif
/*
* Free memory allocated in this routine
*/
safer_free((void **) &np_base);
safer_free((void **) &mesg_send);
safer_free((void **) &mesg_recv);
/*
* When in debug mode, print out a complete listing of variables at
* every node
*/
#ifdef DEBUG_HKM
printf("P_%d at barrier at end of setup_external_nodal_matrlx\n",
ProcID); fflush(stdout);
#ifdef PARALLEL
MPI_Barrier(MPI_COMM_WORLD);
#endif
#endif
}
void
hunt_problem(Comm_Ex *cx, /* array of communications structures */
Exo_DB *exo, /* ptr to the finite element mesh database */
Dpi *dpi) /* distributed processing information */
{
int *ija=NULL; /* column pointer array */
double *a=NULL; /* nonzero array */
double *a_old=NULL; /* nonzero array */
double *x=NULL; /* solution vector */
int iAC; /* COUNTER */
double *x_AC = NULL; /* SOLUTION VECTOR OF EXTRA UNKNOWNS */
double *x_AC_old=NULL; /* old SOLUTION VECTOR OF EXTRA UNKNOWNS */
double *x_AC_dot = NULL;
int iHC; /* COUNTER */
int *ija_attic=NULL; /* storage for external dofs */
int eb_indx, ev_indx;
/*
* variables for path traversal
*/
double *x_old=NULL; /* old solution vector */
double *x_older=NULL; /* older solution vector */
double *x_oldest=NULL; /* oldest solution vector saved */
double *xdot=NULL; /* current path derivative of soln */
double *xdot_old=NULL;
double *x_update=NULL;
double *x_sens=NULL; /* solution sensitivity */
double **x_sens_p=NULL; /* solution sensitivity for parameters */
int num_pvector=0; /* number of solution sensitivity vectors */
#ifdef COUPLED_FILL
struct Aztec_Linear_Solver_System *ams[NUM_ALSS]={NULL};
#else /* COUPLED_FILL */
struct Aztec_Linear_Solver_System *ams[NUM_ALSS]={NULL, NULL};
#endif /* COUPLED_FILL */
/* sl_util_structs.h */
double *resid_vector=NULL; /* residual */
double *resid_vector_sens=NULL; /* residual sensitivity */
double *scale=NULL; /* scale vector for modified newton */
int *node_to_fill = NULL;
int n; /* total number of path steps attempted */
int ni; /* total number of nonlinear solves */
int nt; /* total number of successful path steps */
int path_step_reform; /* counter for jacobian reformation stride */
int converged; /* success or failure of Newton iteration */
int success_ds; /* success or failure of path step */
int i;
int nprint=0, num_total_nodes;
int numProcUnknowns;
int *const_delta_s=NULL;
int step_print;
double i_print;
int good_mesh = TRUE;
double *path=NULL, *path1=NULL;
double *delta_s=NULL, *delta_s_new=NULL, *delta_s_old=NULL;
double *delta_s_older=NULL, *delta_s_oldest=NULL;
double *hDelta_s0=NULL, *hDelta_s_min=NULL, *hDelta_s_max=NULL;
double delta_t;
double theta=0.0;
double damp;
double eps;
double *lambda=NULL, *lambdaEnd=NULL;
double hunt_par, dhunt_par, hunt_par_old; /* hunting continuation parameter */
double timeValueRead = 0.0;
/*
* ALC management variables
*/
int alqALC;
int *aldALC=NULL;
/*
* Other local variables
*/
int error, err, is_steady_state, inewton;
int *gindex = NULL, gsize;
int *p_gsize=NULL;
double *gvec=NULL;
double ***gvec_elem;
double err_dbl;
FILE *file=NULL;
double toler_org[3],damp_org;
struct Results_Description *rd=NULL;
int tnv; /* total number of nodal variables and kinds */
int tev; /* total number of elem variables and kinds */
int tnv_post; /* total number of nodal variables and kinds
for post processing */
int tev_post; /* total number of elem variables and kinds
for post processing */
int max_unk_elem, one, three; /* variables used as mf_setup arguments*/
unsigned int
matrix_systems_mask;
double evol_local=0.0;
#ifdef PARALLEL
double evol_global=0.0;
#endif
static char yo[]="hunt_problem";
/*
* BEGIN EXECUTION
*/
#ifdef DEBUG
fprintf(stderr, "hunt_problem() begins...\n");
#endif
toler_org[0] = custom_tol1;
toler_org[1] = custom_tol2;
toler_org[2] = custom_tol3;
damp_org = damp_factor1;
is_steady_state = TRUE;
p_gsize = &gsize;
/*
* set aside space for gather global vectors to print to exoII file
* note: this is temporary
*
* For 2D prototype problem: allocate space for T, dx, dy arrays
*/
if( strlen( Soln_OutFile) )
{
#ifdef DEBUG
printf("Trying to open \"%s\" for writing.\n", Soln_OutFile);
#endif
file = fopen(Soln_OutFile, "w");
if (file == NULL) {
DPRINTF(stderr, "%s: opening soln file for writing\n", yo);
EH(-1, "\t");
}
}
#ifdef PARALLEL
check_parallel_error("Soln output file error");
#endif
/*
* Some preliminaries to help setup EXODUS II database output.
*/
#ifdef DEBUG
fprintf(stderr, "cnt_nodal_vars() begins...\n");
#endif
tnv = cnt_nodal_vars();
/* tnv_post is calculated in load_nodal_tkn*/
tev = cnt_elem_vars();
/* tev_post is calculated in load_elem_tkn*/
#ifdef DEBUG
fprintf(stderr, "Found %d total primitive nodal variables to output.\n", tnv);
fprintf(stderr, "Found %d total primitive elem variables to output.\n", tev);
#endif
if ( tnv < 0 )
{
DPRINTF(stderr, "%s:\tbad tnv.\n", yo);
EH(-1, "\t");
}
if ( tev < 0 )
{
DPRINTF(stderr, "%s:\tMaybe bad tev? See goma design committee ;) \n", yo);
/* exit(-1); */
}
rd = (struct Results_Description *)
smalloc(sizeof(struct Results_Description));
if (rd == NULL)
{ EH(-1, "Could not grab Results Description."); }
(void) memset((void *) rd, 0, sizeof(struct Results_Description));
rd->nev = 0; /* number element variables in results */
rd->ngv = 0; /* number global variables in results */
rd->nhv = 0; /* number history variables in results */
if ( is_steady_state == TRUE ) {
rd->ngv = 5; /* number global variables in results
see load_global_var_info for names*/
error = load_global_var_info(rd, 0, "CONV");
error = load_global_var_info(rd, 1, "NEWT_IT");
error = load_global_var_info(rd, 2, "MAX_IT");
error = load_global_var_info(rd, 3, "CONVRATE");
error = load_global_var_info(rd, 4, "MESH_VOLUME");
}
/* load nodal types, kinds, names */
error = load_nodal_tkn( rd,
&tnv,
&tnv_post); /* load nodal types, kinds, names */
if (error !=0)
{
DPRINTF(stderr, "%s: problem with load_nodal_tkn()\n", yo);
EH(-1,"\t");
}
/* load elem types, names */
error = load_elem_tkn( rd,
exo,
tev,
&tev_post); /* load elem types, names */
if ( error !=0 )
{
DPRINTF(stderr, "%s: problem with load_elem_tkn()\n", yo);
EH(-1,"\t");
}
/*
* Write out the names of the nodal variables that we will be sending to
* the EXODUS II output file later.
*/
#ifdef DEBUG
fprintf(stderr, "wr_result_prelim() starts...\n", tnv);
#endif
gvec_elem = (double ***) smalloc ( (exo->num_elem_blocks)*sizeof(double **));
for (i = 0; i < exo->num_elem_blocks; i++) {
gvec_elem[i] = (double **) smalloc ( (tev + tev_post)*sizeof(double *));
}
wr_result_prelim_exo( rd,
exo,
ExoFileOut,
gvec_elem );
#ifdef DEBUG
fprintf(stderr, "P_%d: wr_result_prelim_exo() ends...\n", ProcID, tnv);
#endif
/*
* This gvec workhorse transports output variables as nodal based vectors
* that are gather from the solution vector. Note: it is NOT a global
* vector at all and only carries this processor's nodal variables to
* the exodus database.
*/
asdv(&gvec, Num_Node);
/*
* Allocate space and manipulate for all the nodes that this processor
* is aware of...
*/
num_total_nodes = dpi->num_universe_nodes;
numProcUnknowns = NumUnknowns + NumExtUnknowns;
/* allocate memory for Volume Constraint Jacobian. ACS 2/99 */
if ( nAC > 0)
{
for(iAC=0;iAC<nAC;iAC++) {
augc[iAC].d_evol_dx = (double*) malloc(numProcUnknowns*sizeof(double));
} }
asdv(&resid_vector, numProcUnknowns);
asdv(&resid_vector_sens, numProcUnknowns);
asdv(&scale, numProcUnknowns);
for (i=0;i<NUM_ALSS;i++)
{
ams[i] = (struct Aztec_Linear_Solver_System *)
array_alloc(1, 1, sizeof(struct Aztec_Linear_Solver_System ));
}
#ifdef MPI
AZ_set_proc_config( ams[0]->proc_config, MPI_COMM_WORLD );
#ifndef COUPLED_FILL
if( Explicit_Fill ) AZ_set_proc_config( ams[1]->proc_config, MPI_COMM_WORLD );
#endif /* not COUPLED_FILL */
#else /* MPI */
AZ_set_proc_config( ams[0]->proc_config, 0 );
#ifndef COUPLED_FILL
if( Explicit_Fill ) AZ_set_proc_config( ams[1]->proc_config, 0 );
#endif /* not COUPLED_FILL */
#endif /* MPI */
/*
* allocate space for and initialize solution arrays
*/
asdv(&x, numProcUnknowns);
asdv(&x_old, numProcUnknowns);
asdv(&x_older, numProcUnknowns);
asdv(&x_oldest, numProcUnknowns);
asdv(&xdot, numProcUnknowns);
asdv(&xdot_old, numProcUnknowns);
asdv(&x_update, numProcUnknowns);
asdv(&x_sens, numProcUnknowns);
/*
* Initialize solid inertia flag
*/
set_solid_inertia();
/*
* ALLOCATE ALL THOSE WORK VECTORS FOR HUNTING
*/
asdv(&lambda, nHC);
asdv(&lambdaEnd, nHC);
asdv(&path, nHC);
asdv(&path1, nHC);
asdv(&hDelta_s0, nHC);
asdv(&hDelta_s_min, nHC);
asdv(&hDelta_s_max, nHC);
asdv(&delta_s, nHC);
asdv(&delta_s_new, nHC);
asdv(&delta_s_old, nHC);
asdv(&delta_s_older, nHC);
asdv(&delta_s_oldest, nHC);
aldALC = Ivector_birth(nHC);
const_delta_s = Ivector_birth(nHC);
/*
HUNTING BY ZERO AND FIRST ORDER CONTINUATION
*/
alqALC = 1;
damp = 1.0;
delta_t = 0.0;
tran->delta_t = 0.0; /*for Newmark-Beta terms in Lagrangian Solid*/
nprint = 0;
MaxPathSteps = cont->MaxPathSteps;
eps = cont->eps;
for (iHC=0;iHC<nHC;iHC++) {
const_delta_s[iHC] = 0;
lambda[iHC] = hunt[iHC].BegParameterValue;
lambdaEnd[iHC] = hunt[iHC].EndParameterValue;
if ((lambdaEnd[iHC]-lambda[iHC]) > 0.0)
{
aldALC[iHC] = +1;
}
else
{
aldALC[iHC] = -1;
}
if (hunt[iHC].ramp == 1) {
hunt[iHC].Delta_s0 = fabs(lambdaEnd[iHC]-lambda[iHC])/((double)(MaxPathSteps-1));
const_delta_s[iHC] = 1;
}
hDelta_s0[iHC] = hunt[iHC].Delta_s0;
hDelta_s_min[iHC] = hunt[iHC].Delta_s_min;
hDelta_s_max[iHC] = hunt[iHC].Delta_s_max;
path[iHC] = path1[iHC] = lambda[iHC];
if (Debug_Flag && ProcID == 0) {
fprintf(stderr,"MaxPathSteps: %d \tlambdaEnd: %f\n", MaxPathSteps, lambdaEnd[iHC]);
fprintf(stderr,"continuation in progress\n");
}
if (hDelta_s0[iHC] > hDelta_s_max[iHC])
{
hDelta_s0[iHC] = hDelta_s_max[iHC];
}
delta_s[iHC] = delta_s_old[iHC] = delta_s_older[iHC] = hDelta_s0[iHC];
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterHC(iHC, path1[iHC], x, xdot, x_AC, delta_s[iHC], cx, exo, dpi);
}
/* define continuation parameter */
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
hunt_par_old = hunt_par;
/* Call prefront (or mf_setup) if necessary */
if (Linear_Solver == FRONT)
{
/* Also got to define these because it wants pointers to these numbers */
max_unk_elem = (MAX_PROB_VAR + MAX_CONC)*MDE;
one = 1;
three = 3;
/* NOTE: We need a overall flag in the vn_glob struct that tells whether FULL_DG
is on anywhere in domain. This assumes only one material. See sl_front_setup for test.
that test needs to be in the input parser. */
if(vn_glob[0]->dg_J_model == FULL_DG)
{
max_unk_elem = (MAX_PROB_VAR + MAX_CONC)*MDE + 4*vn_glob[0]->modes*4*MDE;
}
if (Num_Proc > 1) EH(-1, "Whoa. No front allowed with nproc>1");
#ifdef HAVE_FRONT
err = mf_setup(&exo->num_elems,
&NumUnknowns,
&max_unk_elem,
&three,
&one,
exo->elem_order_map,
fss->el_proc_assign,
fss->level,
fss->nopdof,
fss->ncn,
fss->constraint,
front_scratch_directory,
&fss->ntra);
EH(err,"problems in frontal setup ");
#else
EH(-1,"Don't have frontal solver compiled and linked in");
#endif
}
/*
* if compute parameter sensitivities, allocate space for solution
* sensitivity vectors
*/
for(i=0;i<nn_post_fluxes_sens;i++) {
num_pvector=MAX(num_pvector,pp_fluxes_sens[i]->vector_id);}
for(i=0;i<nn_post_data_sens;i++) {
num_pvector=MAX(num_pvector,pp_data_sens[i]->vector_id);}
if((nn_post_fluxes_sens + nn_post_data_sens) > 0)
{
num_pvector++;
num_pvector = MAX(num_pvector,2);
x_sens_p = Dmatrix_birth(num_pvector,numProcUnknowns);
}
else
{
x_sens_p = NULL;
}
if (nAC > 0)
{
asdv(&x_AC, nAC);
asdv(&x_AC_old, nAC);
asdv(&x_AC_dot, nAC);
}
/* Allocate sparse matrix */
if( strcmp( Matrix_Format, "msr" ) == 0)
{
log_msg("alloc_MSR_sparse_arrays...");
alloc_MSR_sparse_arrays(&ija,
&a,
&a_old,
0,
node_to_fill,
exo,
dpi);
/*
* An attic to store external dofs column names is needed when
* running in parallel.
*/
alloc_extern_ija_buffer(num_universe_dofs,
num_internal_dofs+num_boundary_dofs,
ija, &ija_attic);
/*
* Any necessary one time initialization of the linear
* solver package (Aztec).
*/
ams[JAC]->bindx = ija;
ams[JAC]->val = a;
ams[JAC]->belfry = ija_attic;
ams[JAC]->val_old = a_old;
/*
* These point to nowhere since we're using MSR instead of VBR
* format.
*/
ams[JAC]->indx = NULL;
ams[JAC]->bpntr = NULL;
ams[JAC]->rpntr = NULL;
ams[JAC]->cpntr = NULL;
ams[JAC]->npn = dpi->num_internal_nodes + dpi->num_boundary_nodes;
ams[JAC]->npn_plus = dpi->num_internal_nodes + dpi->num_boundary_nodes + dpi->num_external_nodes;
ams[JAC]->npu = num_internal_dofs+num_boundary_dofs;
ams[JAC]->npu_plus = num_universe_dofs;
ams[JAC]->nnz = ija[num_internal_dofs+num_boundary_dofs] - 1;
ams[JAC]->nnz_plus = ija[num_universe_dofs];
}
else if( strcmp( Matrix_Format, "vbr" ) == 0)
{
log_msg("alloc_VBR_sparse_arrays...");
alloc_VBR_sparse_arrays ( ams[JAC],
exo,
dpi);
ija_attic = NULL;
ams[JAC]->belfry = ija_attic;
a = ams[JAC]->val;
if( !save_old_A ) a_old = ams[JAC]->val_old;
}
else if ( strcmp( Matrix_Format, "front") == 0 )
{
/* Don't allocate any sparse matrix space when using front */
ams[JAC]->bindx = NULL;
ams[JAC]->val = NULL;
ams[JAC]->belfry = NULL;
ams[JAC]->val_old = NULL;
ams[JAC]->indx = NULL;
ams[JAC]->bpntr = NULL;
ams[JAC]->rpntr = NULL;
ams[JAC]->cpntr = NULL;
}
else
{
EH(-1,"Attempted to allocate unknown sparse matrix format");
}
init_vec(x, cx, exo, dpi, x_AC, nAC, &timeValueRead);
/* if read ACs, update data floats */
if (nAC > 0)
{
if(augc[0].iread == 1)
{
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi); }
}
}
/*
* set boundary conditions on the initial conditions
*/
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
dcopy1(numProcUnknowns,x,x_old);
dcopy1(numProcUnknowns,x_old,x_older);
dcopy1(numProcUnknowns,x_older,x_oldest);
if( nAC > 0)
{
dcopy1(nAC,x_AC, x_AC_old);}
/*
* initialize the counters for when to print out data
*/
step_print = 1;
matrix_systems_mask = 1;
log_msg("sl_init()...");
sl_init(matrix_systems_mask, ams, exo, dpi, cx);
#ifdef PARALLEL
/*
* Make sure the solver was properly initialized on all processors.
*/
check_parallel_error("Solver initialization problems");
#endif
ams[JAC]->options[AZ_keep_info] = 1;
DPRINTF(stderr, "\nINITIAL ELEMENT QUALITY CHECK---\n");
good_mesh = element_quality(exo, x, ams[0]->proc_config);
/*
* set the number of successful path steps to zero
*/
nt = 0;
/*
* LOOP THROUGH PARAMETER UNTIL MAX NUMBER
* OF STEPS SURPASSED
*/
for (n=0;n<MaxPathSteps;n++) {
alqALC = 1;
for (iHC=0;iHC<nHC;iHC++) {
switch (aldALC[iHC]) {
case -1: /* REDUCING PARAMETER DIRECTION */
if (path1[iHC] <= lambdaEnd[iHC]) {
alqALC = -1;
path1[iHC] = lambdaEnd[iHC];
delta_s[iHC] = path[iHC]-path1[iHC];
}
break;
case +1: /* RISING PARAMETER DIRECTION */
if (path1[iHC] >= lambdaEnd[iHC]) {
alqALC = -1;
path1[iHC] = lambdaEnd[iHC];
delta_s[iHC] = path1[iHC]-path[iHC];
}
break;
}
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterHC(iHC, path1[iHC], x, xdot, x_AC, delta_s[iHC], cx, exo, dpi);
} /* end of iHC loop */
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
/*
* IF STEP CHANGED, REDO FIRST ORDER PREDICTION
*/
if(alqALC == -1)
{
DPRINTF(stderr,"\n\t ******** LAST PATH STEP!\n");
dcopy1(numProcUnknowns,x_old,x);
dhunt_par = hunt_par-hunt_par_old;
switch (Continuation) {
case HUN_ZEROTH:
break;
case HUN_FIRST:
v1add(numProcUnknowns, &x[0], dhunt_par, &x_sens[0]);
break;
}
}
/*
* reset Dirichlet condition Mask, node->DBC to -1 where it
* is set in order for Dirichlet conditions to be
* set appropriately for each path step
*/
nullify_dirichlet_bcs();
find_and_set_Dirichlet (x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
if(ProcID ==0) {
DPRINTF(stderr, "\n\t----------------------------------");
switch (Continuation) {
case HUN_ZEROTH:
DPRINTF(stderr, "\n\tZero Order Hunting:");
break;
case HUN_FIRST:
DPRINTF(stderr, "\n\tFirst Order Hunting:");
break; }
DPRINTF(stderr, "\n\tStep number: %4d of %4d (max)", n+1, MaxPathSteps);
DPRINTF(stderr, "\n\tAttempting solution at: theta = %g",hunt_par);
for (iHC=0;iHC<nHC;iHC++) {
switch (hunt[iHC].Type) {
case 1: /* BC */
DPRINTF(stderr, "\n\tBCID=%3d DFID=%5d", hunt[iHC].BCID, hunt[iHC].DFID);
break;
case 2: /* MT */
DPRINTF(stderr, "\n\tMTID=%3d MPID=%5d", hunt[iHC].MTID, hunt[iHC].MPID);
break;
case 3: /* AC */
DPRINTF(stderr, "\n\tACID=%3d DFID=%5d", hunt[iHC].BCID, hunt[iHC].DFID);
break;
}
DPRINTF(stderr, " Parameter= % 10.6e delta_s= %10.6e", path1[iHC], delta_s[iHC]);
}
}
ni = 0;
do {
#ifdef DEBUG
fprintf(stderr, "%s: starting solve_nonlinear_problem\n", yo);
#endif
err = solve_nonlinear_problem(ams[JAC],
x,
delta_t,
theta,
x_old,
x_older,
xdot,
xdot_old,
resid_vector,
x_update,
scale,
&converged,
&nprint,
tev,
tev_post,
NULL,
rd,
gindex,
p_gsize,
gvec,
gvec_elem,
path1[0],
exo,
dpi,
cx,
0,
&path_step_reform,
is_steady_state,
x_AC,
x_AC_dot,
hunt_par,
resid_vector_sens,
x_sens,
x_sens_p,
NULL);
#ifdef DEBUG
fprintf(stderr, "%s: returned from solve_nonlinear_problem\n", yo);
#endif
if (err == -1) converged = 0;
inewton = err;
if (converged)
{
EH(error, "error writing ASCII soln file."); /* srs need to check */
if (Write_Intermediate_Solutions == 0) {
#ifdef DEBUG
fprintf(stderr, "%s: write_solution call WIS\n", yo);
#endif
write_solution(ExoFileOut, resid_vector, x, x_sens_p, x_old,
xdot, xdot_old, tev, tev_post,NULL, rd, gindex,
p_gsize, gvec, gvec_elem, &nprint, delta_s[0],
theta, path1[0], NULL, exo, dpi);
#ifdef DEBUG
fprintf(stderr, "%s: write_solution end call WIS\n", yo);
#endif
}
/*
* PRINT OUT VALUES OF EXTRA UNKNOWNS
* FROM AUGMENTING CONDITIONS
*/
if (nAC > 0)
{
DPRINTF(stderr, "\n------------------------------\n");
DPRINTF(stderr, "Augmenting Conditions: %4d\n", nAC);
DPRINTF(stderr, "Number of extra unknowns: %4d\n\n", nAC);
for (iAC = 0; iAC < nAC; iAC++)
{
if (augc[iAC].Type == AC_USERBC)
{
DPRINTF(stderr, "\tAC[%4d] DF[%4d] = %10.6e\n",
augc[iAC].BCID, augc[iAC].DFID, x_AC[iAC]);
}
else if (augc[iAC].Type == AC_USERMAT ||
augc[iAC].Type == AC_FLUX_MAT )
{
DPRINTF(stderr, "\n MT[%4d] MP[%4d] = %10.6e\n",
augc[iAC].MTID, augc[iAC].MPID, x_AC[iAC]);
}
else if(augc[iAC].Type == AC_VOLUME)
{
evol_local = augc[iAC].evol;
#ifdef PARALLEL
if( Num_Proc > 1 ) {
MPI_Allreduce( &evol_local, &evol_global, 1,
MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
evol_local = evol_global;
#endif
DPRINTF(stderr, "\tMT[%4d] VC[%4d]=%10.6e Param=%10.6e\n",
augc[iAC].MTID, augc[iAC].VOLID, evol_local,
x_AC[iAC]);
}
else if(augc[iAC].Type == AC_POSITION)
{
evol_local = augc[iAC].evol;
#ifdef PARALLEL
if( Num_Proc > 1 ) {
MPI_Allreduce( &evol_local, &evol_global, 1,
MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
evol_local = evol_global;
#endif
DPRINTF(stderr, "\tMT[%4d] XY[%4d]=%10.6e Param=%10.6e\n",
augc[iAC].MTID, augc[iAC].VOLID, evol_local,
x_AC[iAC]);
}
else if(augc[iAC].Type == AC_FLUX)
{
DPRINTF(stderr, "\tBC[%4d] DF[%4d]=%10.6e\n",
augc[iAC].BCID, augc[iAC].DFID, x_AC[iAC]);
}
}
}
/* Check element quality */
good_mesh = element_quality(exo, x, ams[0]->proc_config);
/*
INTEGRATE FLUXES, FORCES
*/
for (i = 0; i < nn_post_fluxes; i++)
{
err_dbl = evaluate_flux ( exo, dpi,
pp_fluxes[i]->ss_id,
pp_fluxes[i]->flux_type ,
pp_fluxes[i]->flux_type_name ,
pp_fluxes[i]->blk_id ,
pp_fluxes[i]->species_number,
pp_fluxes[i]->flux_filenm,
pp_fluxes[i]->profile_flag,
x,xdot,NULL,delta_s[0],path1[0],1);
}
/*
COMPUTE FLUX, FORCE SENSITIVITIES
*/
for (i = 0; i < nn_post_fluxes_sens; i++)
{
err_dbl = evaluate_flux_sens ( exo, dpi,
pp_fluxes_sens[i]->ss_id,
pp_fluxes_sens[i]->flux_type ,
pp_fluxes_sens[i]->flux_type_name ,
pp_fluxes_sens[i]->blk_id ,
pp_fluxes_sens[i]->species_number,
pp_fluxes_sens[i]->sens_type,
pp_fluxes_sens[i]->sens_id,
pp_fluxes_sens[i]->sens_flt,
pp_fluxes_sens[i]->sens_flt2,
pp_fluxes_sens[i]->vector_id,
pp_fluxes_sens[i]->flux_filenm,
pp_fluxes_sens[i]->profile_flag,
x,xdot,x_sens_p,delta_s[0],path1[0],1);
}
/*
* Compute global volumetric quantities
*/
for (i = 0; i < nn_volume; i++ ) {
evaluate_volume_integral(exo, dpi,
pp_volume[i]->volume_type,
pp_volume[i]->volume_name,
pp_volume[i]->blk_id,
pp_volume[i]->species_no,
pp_volume[i]->volume_fname,
pp_volume[i]->params,
NULL, x, xdot, delta_s[0],
path1[0], 1);
}
} /* end of if converged block */
/*
* INCREMENT COUNTER
*/
ni++;
/*
*
* DID IT CONVERGE ?
* IF NOT, REDUCE STEP SIZE AND TRY AGAIN
*
*/
if (!converged) {
if (ni > 10) {
DPRINTF(stderr,"\n ************************************\n");
DPRINTF(stderr," W: Did not converge in Newton steps.\n");
DPRINTF(stderr," Find better initial guess. \n");
DPRINTF(stderr," ************************************\n");
exit(0);
}
/*
* ADJUST STEP SIZE - unless failed on first step
*/
if ( nt != 0 )
{
DPRINTF(stderr, "\n\tFailed to converge:\n");
for (iHC=0;iHC<nHC;iHC++) {
delta_s[iHC] *= 0.5;
switch (aldALC[iHC]) {
case -1:
path1[iHC] = path[iHC] - delta_s[iHC];
break;
case +1:
path1[iHC] = path[iHC] + delta_s[iHC];
break;
}
/*
* RESET
*/
alqALC = 1;
DPRINTF(stderr, "Decreasing step-length to %10.6e.\n", delta_s[iHC]);
if (delta_s[iHC] < hDelta_s_min[iHC]) {
DPRINTF(stderr,"\n X: C step-length reduced below minimum.");
DPRINTF(stderr,"\n Program terminated.\n");
/* This needs to have a return value of 0, indicating
* success, for the continuation script to not treat this
* as a failed command. */
exit(0);
}
#ifdef PARALLEL
check_parallel_error("\t");
#endif
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterHC(iHC, path1[iHC], x, xdot, x_AC, delta_s[iHC], cx, exo, dpi);
} /* end of iHC loop */
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
/*
* GET ZERO OR FIRST ORDER PREDICTION
*/
dhunt_par = hunt_par-hunt_par_old;
switch (Continuation) {
case HUN_ZEROTH:
vcopy(numProcUnknowns, &x[0], 1.0, &x_old[0]);
break;
case HUN_FIRST:
v2sum(numProcUnknowns, &x[0], 1.0, &x_old[0], dhunt_par, &x_sens[0]);
break;
}
/* MMH: Needed to put this in, o/w it may find that the
* solution and residual HAPPEN to satisfy the convergence
* criterion for the next newton solve...
*/
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
if (nAC > 0)
{
dcopy1(nAC, x_AC_old, x_AC);
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi); }
}
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
}
else if (inewton == -1)
{
DPRINTF(stderr,"\nHmm... trouble on first step \n Let's try some more relaxation \n");
if((damp_factor1 <= 1. && damp_factor1 >= 0.) &&
(damp_factor2 <= 1. && damp_factor2 >= 0.) &&
(damp_factor3 <= 1. && damp_factor3 >= 0.))
{
custom_tol1 *= 0.01;
custom_tol2 *= 0.01;
custom_tol3 *= 0.01;
DPRINTF(stderr," custom tolerances %g %g %g \n",custom_tol1,custom_tol2,custom_tol3);
}
else
{
damp_factor1 *= 0.5;
DPRINTF(stderr," damping factor %g \n",damp_factor1);
}
vcopy(numProcUnknowns, &x[0], 1.0, &x_old[0]);
/* MMH: Needed to put this in, o/w it may find that the
* solution and residual HAPPEN to satisfy the convergence
* criterion for the next newton solve...
*/
find_and_set_Dirichlet(x, xdot, exo, dpi);
exchange_dof(cx, dpi, x);
if (nAC > 0)
{
dcopy1(nAC, x_AC_old, x_AC);
for(iAC=0 ; iAC<nAC ; iAC++)
{ update_parameterAC(iAC, x, xdot, x_AC, cx, exo, dpi); }
}
}
else
{
DPRINTF(stderr,"\nHmm... could not converge on first step\n Let's try some more iterations\n");
if((damp_factor1 <= 1. && damp_factor1 >= 0.) &&
(damp_factor2 <= 1. && damp_factor2 >= 0.) &&
(damp_factor3 <= 1. && damp_factor3 >= 0.))
{
custom_tol1 *= 100.;
custom_tol2 *= 100.;
custom_tol3 *= 100.;
DPRINTF(stderr," custom tolerances %g %g %g \n",custom_tol1,custom_tol2,custom_tol3);
}
else
{
damp_factor1 *= 2.0;
damp_factor1 = MIN(damp_factor1,1.0);
DPRINTF(stderr," damping factor %g \n",damp_factor1);
}
}
} /* end of !converged */
} while (converged == 0);
/*
* CONVERGED
*/
nt++;
custom_tol1 = toler_org[0];
custom_tol2 = toler_org[1];
custom_tol3 = toler_org[2];
damp_factor1 = damp_org;
DPRINTF(stderr,
"\n\tStep accepted, theta (proportion complete) = %10.6e\n",
hunt_par);
for (iHC=0;iHC<nHC;iHC++) {
switch (hunt[iHC].Type) {
case 1: /* BC */
DPRINTF(stderr, "\tStep accepted, BCID=%3d DFID=%5d",
hunt[iHC].BCID, hunt[iHC].DFID);
break;
case 2: /* MT */
DPRINTF(stderr, "\tStep accepted, MTID=%3d MPID=%5d",
hunt[iHC].MTID, hunt[iHC].MPID);
break;
case 3: /* AC */
DPRINTF(stderr, "\tStep accepted, ACID=%3d DFID=%5d",
hunt[iHC].BCID, hunt[iHC].DFID);
break;
}
DPRINTF(stderr, " Parameter= % 10.6e\n", path1[iHC]);
}
/*
* check path step error, if too large do not enlarge path step
*/
for (iHC=0;iHC<nHC;iHC++) {
if ((ni == 1) && (n != 0) && (!const_delta_s[iHC]))
{
delta_s_new[iHC] = path_step_control(num_total_nodes,
delta_s[iHC], delta_s_old[iHC],
x,
eps,
&success_ds,
cont->use_var_norm, inewton);
if (delta_s_new[iHC] > hDelta_s_max[iHC]) {delta_s_new[iHC] = hDelta_s_max[iHC];}
}
else
{
success_ds = 1;
delta_s_new[iHC] = delta_s[iHC];
}
}
/*
* determine whether to print out the data or not
*/
i_print = 0;
if (nt == step_print) {
i_print = 1;
step_print += cont->print_freq; }
if (alqALC == -1)
{ i_print = 1; }
if (i_print) {
error = write_ascii_soln(x, resid_vector, numProcUnknowns,
x_AC, nAC, path1[0], file);
if (error) {
DPRINTF(stderr, "%s: error writing ASCII soln file\n", yo);
}
if ( Write_Intermediate_Solutions == 0 ) {
write_solution(ExoFileOut, resid_vector, x, x_sens_p,
x_old, xdot, xdot_old, tev, tev_post, NULL,
rd, gindex, p_gsize, gvec, gvec_elem, &nprint,
delta_s[0], theta, path1[0], NULL, exo, dpi);
nprint++;
}
}
/*
* backup old solutions
* can use previous solutions for prediction one day
*/
dcopy1(numProcUnknowns,x_older,x_oldest);
dcopy1(numProcUnknowns,x_old,x_older);
dcopy1(numProcUnknowns,x,x_old);
dcopy1(nHC,delta_s_older,delta_s_oldest);
dcopy1(nHC,delta_s_old ,delta_s_older );
dcopy1(nHC,delta_s ,delta_s_old );
dcopy1(nHC,delta_s_new ,delta_s );
/*
delta_s_oldest = delta_s_older;
delta_s_older = delta_s_old;
delta_s_old = delta_s;
delta_s = delta_s_new;
*/
hunt_par_old=hunt_par;
if ( nAC > 0) {
dcopy1(nAC, x_AC, x_AC_old);
}
/*
* INCREMENT/DECREMENT PARAMETER
*/
for (iHC=0;iHC<nHC;iHC++) {
path[iHC] = path1[iHC];
switch (aldALC[iHC]) {
case -1:
path1[iHC] = path[iHC] - delta_s[iHC];
break;
case +1:
path1[iHC] = path[iHC] + delta_s[iHC];
break;
}
/*
* ADJUST NATURAL PARAMETER
*/
update_parameterHC(iHC, path1[iHC], x, xdot, x_AC, delta_s[iHC], cx, exo, dpi);
} /* end of iHC loop */
/*
* GET FIRST ORDER PREDICTION
*/
if(hunt[0].EndParameterValue == hunt[0].BegParameterValue)
{ hunt_par = 1.0; }
else
{
hunt_par = (path1[0]-hunt[0].BegParameterValue)
/(hunt[0].EndParameterValue - hunt[0].BegParameterValue) ;
hunt_par=fabs(hunt_par);
}
dhunt_par = hunt_par-hunt_par_old;
switch (Continuation) {
case HUN_ZEROTH:
break;
case HUN_FIRST:
v1add(numProcUnknowns, &x[0], dhunt_par, &x_sens[0]);
break; }
if (!good_mesh) goto free_and_clear;
/*
*
* CHECK END CONTINUATION
*
*/
if (alqALC == -1)
{ alqALC = 0; }
else
{ alqALC = 1; }
if (alqALC == 0) {
DPRINTF(stderr,"\n\n\t I will continue no more!\n\t No more continuation for you!\n");
goto free_and_clear;
}
} /* n */
if(n == MaxPathSteps &&
aldALC[0] * (lambdaEnd[0] - path[0]) > 0)
{
DPRINTF(stderr,"\n\tFailed to reach end of hunt in maximum number of successful steps (%d).\n\tSorry.\n",
MaxPathSteps);
exit(0);
}
#ifdef PARALLEL
check_parallel_error("Hunting error");
#endif
/*
* DONE CONTINUATION
*/
free_and_clear:
/*
* Transform the node point coordinates according to the
* displacements and write out all the results using the
* displaced coordinates. Set the displacement field to
* zero, too.
*/
if (Anneal_Mesh) {
#ifdef DEBUG
fprintf(stderr, "%s: anneal_mesh()...\n", yo);
#endif
err = anneal_mesh(x, tev, tev_post, NULL, rd, path1[0], exo, dpi);
#ifdef DEBUG
DPRINTF(stderr, "%s: anneal_mesh()-done\n", yo);
#endif
EH(err, "anneal_mesh() bad return.");
}
/*
* Free a bunch of variables that aren't needed anymore
*/
safer_free((void **) &ROT_Types);
safer_free((void **) &node_to_fill);
safer_free( (void **) &resid_vector);
safer_free( (void **) &resid_vector_sens);
safer_free( (void **) &scale);
safer_free( (void **) &x);
if (nAC > 0) {
safer_free( (void **) &x_AC);
safer_free( (void **) &x_AC_old);
safer_free( (void **) &x_AC_dot);
}
safer_free( (void **) &x_old);
safer_free( (void **) &x_older);
safer_free( (void **) &x_oldest);
safer_free( (void **) &xdot);
safer_free( (void **) &xdot_old);
safer_free( (void **) &x_update);
safer_free( (void **) &x_sens);
if((nn_post_data_sens+nn_post_fluxes_sens) > 0)
Dmatrix_death(x_sens_p,num_pvector,numProcUnknowns);
for(i = 0; i < MAX_NUMBER_MATLS; i++) {
for(n = 0; n < MAX_MODES; n++) {
safer_free((void **) &(ve_glob[i][n]->gn));
safer_free((void **) &(ve_glob[i][n]));
}
safer_free((void **) &(vn_glob[i]));
}
sl_free(matrix_systems_mask, ams);
for (i=0;i<NUM_ALSS;i++) {
safer_free( (void**) &(ams[i]));
}
safer_free( (void **) &gvec);
safer_free( (void **) &lambda);
safer_free( (void **) &lambdaEnd);
safer_free( (void **) &path);
safer_free( (void **) &path1);
safer_free( (void **) &hDelta_s0);
safer_free( (void **) &hDelta_s_min);
safer_free( (void **) &hDelta_s_max);
safer_free( (void **) &delta_s);
safer_free( (void **) &delta_s_new);
safer_free( (void **) &delta_s_old);
safer_free( (void **) &delta_s_older);
safer_free( (void **) &delta_s_oldest);
Ivector_death(&aldALC[0], nHC);
Ivector_death(&const_delta_s[0], nHC);
i = 0;
for ( eb_indx = 0; eb_indx < exo->num_elem_blocks; eb_indx++ ) {
for ( ev_indx = 0; ev_indx < rd->nev; ev_indx++ ) {
if ( exo->elem_var_tab[i++] == 1 ) {
safer_free ((void **) &(gvec_elem [eb_indx][ev_indx]) );
}
}
safer_free ((void **) &(gvec_elem [eb_indx]));
}
safer_free( (void **) &gvec_elem);
safer_free( (void **) &rd);
safer_free( (void **) &Local_Offset);
safer_free( (void **) &Dolphin);
if( strlen( Soln_OutFile) )
{
fclose(file);
}
return;
} /* END of routine hunt_problem */
void
add_info_stamp(Exo_DB *exo)
{
int i;
int k;
int n;
char **a;
char buf[MAX_LINE_LENGTH+1];
time_t now, then;
#ifdef NO_LEAKY_GETPWUID
struct passwd *pwe;
#endif
struct utsname utsname;
INFO_Record *I;
n = exo->num_info;
if ( n+10 > MAX_INFO )
{
return;
}
exo->num_info += 10;
/*
buf[0] = '\0';
ni = (char **) calloc( exo->num_info, sizeof(char *));
*/
/*
* Allocate space for the new info record.
*/
I = (INFO_Record *) smalloc(exo->num_info*sizeof(INFO_Record));
for ( i=0; i<exo->num_info; i++)
{
I[i] = (char *) smalloc(MAX_LINE_LENGTH*sizeof(char));
}
/*
* Transcribe any old records...
*/
for ( i=0; i<n; i++)
{
strcpy(I[i], exo->info[i]);
}
/*
* Initialize the new records to terminating nulls...
*/
for ( i=n; i<exo->num_info; i++)
{
for ( k=0; k<MAX_LINE_LENGTH; k++)
{
I[i][k] = '\0';
}
}
/*
* Fill in the new records with information about this run.
*/
strcpy(I[n], "____");
/*
* -9 -- the command line issued for this simulation
*/
/*
for ( i=0; i<Argc; i++)
{
strcat(buf, Argv[i]);
strcat(buf, " ");
}
*/
for ( i=0; i<MAX_LINE_LENGTH; i++)
{
buf[i] = '\0';
}
a = Argv;
if ( a != NULL )
{
i = 0;
/* MMH: This needs a +2: +1 for the space, and +1 for the
* null.
*/
while (*a != NULL &&
((strlen(buf) + strlen(*a) + 2) < MAX_LINE_LENGTH) )
{
strcat(buf, *a);
strcat(buf, " ");
a++;
}
}
strcpy(I[n+1], buf);
/*
* -8 -- the date and time of the simulation
*/
now = time(&then);
strftime(buf, MAX_LINE_LENGTH, "%C", localtime(&now));
strcpy(I[n+2], buf);
/*
* -7 -- current working directory
*/
if ( ProcID < 8 ) /* too much I/O overhead for many procs */
{
char *cwderr;
cwderr = getcwd(buf, MAX_LINE_LENGTH+1);
if (cwderr == NULL) {
strcpy(buf, ".");
}
}
else
{
strcpy(buf, ".");
}
strcpy(I[n+3], buf);
/*
* -6 -- the name of the user
*/
sprintf(buf, "uid %d", (int)(getuid()));
#ifdef NO_LEAKY_GETPWUID
pwe = getpwuid(getuid());
strcpy(buf, pwe->pw_name);
#endif
strcpy(I[n+4], buf);
/*
* -5 through -1 -- the POSIX system information
*/
uname(&utsname);
/* Lets be on the safe side put one char less than MAX_LINE_LENGTH into the info buffers */
strncpy(I[n+5], utsname.sysname, MAX_LINE_LENGTH-1);
strncpy(I[n+6], utsname.nodename, MAX_LINE_LENGTH-1);
strncpy(I[n+7], utsname.release, MAX_LINE_LENGTH-1);
strncpy(I[n+8], utsname.version, MAX_LINE_LENGTH-1);
strncpy(I[n+9], utsname.machine, MAX_LINE_LENGTH-1);
/*
* Free the old beast and assign the new one.
*/
for ( i=0; i<n; i++)
{
safer_free((void **)&(exo->info[i]));
}
if ( n > 0 )
{
safer_free((void **) &(exo->info));
}
exo->info = I;
return;
}
int
lu_decomp ( double **a,
const int n,
int *indx,
double *d )
{
int i, imax=-1, j, k;
double big, dum, sum, temp;
/* vv stores the implicit scaling of each row */
static double *vv=NULL;
static int n_max=0;
if (n > n_max) {
safer_free((void **) &vv);
vv = alloc_dbl_1(n, DBL_NOINIT);
n_max = n;
}
*d = 1.0; /* No row interchanges yet */
for ( i = 0; i < n; i++ ) { /* loop over rows to get the implicit scaling info */
big = 0.0;
for ( j = 0; j < n; j++ ) {
if ( ( temp = fabs( a[i][j] ) ) > big) {
big = temp;
}
}
if ( big == 0.0 ) {
printf("Singular matrix in routine lu_decomp - aborting\n");
return (-1);
}
vv[i] = 1.0/big; /* save the implicit scaling info */
}
for ( j = 0; j < n; j++ ) { /* Looping over columns (Crout's method) */
for ( i = 0; i < j; i++ ) { /* This is Eq. 2.3.12 except for i == j */
sum = a[i][j];
for ( k = 0; k < i; k++ ) {
sum -= a[i][k]*a[k][j];
}
a[i][j] = sum;
}
big = 0.0; /* Initialize the search for the largest pivot element */
for ( i = j; i < n; i++ ) { /* This is i == j of Eq. 2.3.12 & i = j+1..N for Eq. 2.3.13 */
sum = a[i][j];
for ( k = 0; k < j; k++ ) {
sum -= a[i][k]*a[k][j];
}
a[i][j] = sum;
if( ( dum = vv[i]*fabs(sum) ) >= big ) { /* Is the figure of merit for the pivot */
big = dum; /* better than the best so far? */
imax = i;
}
}
if( j != imax ) { /* Do we need to interchange rows? */
for ( k = 0; k < n; k++ ) { /* Interchange them */
dum = a[imax][k];
a[imax][k] = a[j][k];
a[j][k] = dum;
}
(*d) = -(*d); /* ...and change the parity of d */
vv[imax] = vv[j]; /* also change the scale factor */
}
indx[j] = imax;
if( a[j][j] == 0.0 ) {
a[j][j] = TINY;
} /* If the pivot element is 0, the matrix is singular
(at least to the precision of the algorithm). For
some applications on singular matrices, it is desirable
to substitute TINY for 0. */
if( j != (n - 1) ) { /* Divide by the pivot element */
dum = 1.0/(a[j][j]);
for( i = j + 1; i < n; i++ ) {
a[i][j] *= dum;
}
}
} /* Get the next column */
return (0);
}
int
get_new_coord(double *new_coord[DIM],
double *x,
const Exo_DB *exo )
{
int p,i,j;
int dim = exo->num_dim;
int num_nodes = exo->num_nodes;
int displacement_somewhere = FALSE;
int ln;
int *moved;
int e_start = exo->eb_ptr[0];
int e_end = exo->eb_ptr[exo->num_elem_blocks];
int ielem;
int gnn;
int var;
double phi[MDE];
for(p = 0; p < dim; p++)
{
new_coord[p] = (double *) calloc(num_nodes, sizeof(double));
dcopy1( num_nodes, Coor[p], new_coord[p] );
}
for(p = 0; p < upd->Num_Mat; p++)
displacement_somewhere |= ( pd_glob[p]->e[R_MESH1] );
if ( displacement_somewhere == FALSE ) return (FALSE );
moved = (int *) calloc( num_nodes, sizeof(int) );
/*
* Loop through nodes, find displacement, and add it into
* the coordinate
*/
for(ielem = e_start; ielem < e_end; ielem++)
{
double displacement[DIM];
load_elem_dofptr(ielem, exo, x, x, x, x, x, 1);
for(ln = 0; ln < ei->num_local_nodes; ln++)
{
double xi[3] = {0.0, 0.0, 0.0};
find_nodal_stu(ln, ei->ielem_type, xi, xi+1, xi+2);
gnn = exo->elem_node_list[ exo->elem_node_pntr[ielem] + ln ] ;
memset(displacement, 0, sizeof(double)*DIM);
if( moved[gnn] != 1 )
{
for(p = 0; p < DIM; p++)
{
var = MESH_DISPLACEMENT1 + p;
for(i = 0; i < ei->dof[var]; i++)
{
phi[i] = newshape(xi,
ei->ielem_type,
PSI,
ei->dof_list[var][i],
ei->ielem_shape,
pd->i[var],
i);
}
if( pd->v[var] )
{
for(j = 0; j < ei->dof[var]; j++)
{
displacement[p] += *esp->d[p][j] * phi[j];
}
moved[gnn] = 1;
}
else
displacement[p] = 0.0;
}
}
for(p = 0; p < dim; p++)
new_coord[p][gnn] += displacement[p];
}
}
safer_free((void **) &moved);
return( TRUE );
}