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
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
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 */
int
goma_init_(dbl *time1, int *nnodes, int *nelems,
int *nnv_in, int *nev_in, int *i_soln, int *i_post)
/*
* 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 the_time;
#endif
int error;
int i;
int j;
static int first_goma_call=TRUE;
char **ptmp;
static const char *yo="goma_init";
struct Command_line_command **clc=NULL; /* point to command line structure */
int nclc = 0; /* number of command line commands */
/********************** BEGIN EXECUTION ***************************************/
/* 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
*/
#ifdef PARALLEL
if( first_goma_call ) {
Argc = 1;
Argv = (char **) smalloc( Argc*sizeof(char *) );
Argv[0] = (char *) yo;
MPI_Init(&Argc, &Argv); /*PRS will have to fix this. Too late TAB already did. */
}
time_start = MPI_Wtime();
#else /* PARALLEL */
(void) time(&the_time);
tm_ptr = gmtime(&the_time);
time_start = (double) ( tm_ptr->tm_sec
+ 60. * ( 60. * ( tm_ptr->tm_yday * 24. + tm_ptr->tm_hour )
+ tm_ptr->tm_min )
);
#endif /* PARALLEL */
*time1 = time_start;
/* Argv = argv; */
/* Argc = argc; */
time_goma_started = time_start;
#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...");
#ifdef USE_CGM
cgm_initialize();
#endif
/*
* Some initial stuff that only the master process does.
*/
/*PRS: Disable this command line stuff for the jas coupled version */
/*-----------------------------------------------------------------*/
/* 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 */
/* } */
/* } */
/* PRS For the JAS version we will use the default input file name "input" */
strcpy(Input_File, "input");
/* if (argc > 1) translate_command_line(argc, argv, clc, &nclc); */
/* 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 = libio_alloc();
EH(error, "libio_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
/*PRS AGAIN, NO COMMAND LINE OVERRIDES IN THIS JAS3D VERSION */
/*
* Read ASCII input file, data files, related exodusII FEM databases.
*/
if ( ProcID == 0 )
{
log_msg("Reading input file ...");
read_input_file(clc, nclc);
}
/*
* 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).
*
*/
#ifdef USE_CGM
create_cgm_geometry();
#endif
/*
* 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");
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/*
* 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);
}
}
if (Num_Import_NV > 0 || Num_Import_EV > 0) printf
(" Goma will import %d nodal and %d element variables.\n",
Num_Import_NV, Num_Import_EV);
if (Num_Export_XS > 0 || Num_Export_XP > 0) printf
(" Goma will export %d solution and %d post-processing variables.\n",
Num_Export_XS, Num_Export_XP);
/* Return counts to calling program */
*nnodes = EXO_ptr->num_nodes;
*nelems = EXO_ptr->num_elems;
*nnv_in = Num_Import_NV;
*nev_in = Num_Import_EV;
*i_soln = Num_Export_XS;
*i_post = Num_Export_XP;
return (0); /* Back to animas*/
}
