int
create_eigen_outfiles(Exo_DB *exo, Dpi *dpi,
RESULTS_DESCRIPTION_STRUCT *rd)
/*
* Routine to open an array of MxN eigenvector output files.
* M = specified Eigen_Record_Modes
* N = specified LSA_number_wave_numbers
* Pointers to these files are returned in array **fp.
*/
{
int m = eigen->Eigen_Record_Modes;
int n = LSA_number_wave_numbers;
char fname[MAX_FNL];
int i, j, k, n1;
/* Determine if doing 3D of 2D LSA */
if (Linear_Stability == LSA_3D_OF_2D
|| Linear_Stability == LSA_3D_OF_2D_SAVE)
{
n1 = n;
}
else
{
n1 = 1;
n = 0;
}
/* Record mode loop */
for (j=0; j<m; j++)
{
/* Wave number loop */
for (k=0; k<n1; k++)
{
/* Create name for this file */
for (i=0; i<MAX_FNL; i++)
{
fname[i] = '\0';
}
strcpy(fname, eigen->Eigen_Output_File);
get_eigen_outfile_name(fname, j, k);
/* Now, open a new ExodusII file with this composite name
and initialize with basic mesh information */
one_base(exo);
wr_mesh_exo(exo, fname, 0);
wr_result_prelim_exo(rd, exo, fname, NULL);
if (Num_Proc > 1) wr_dpi(dpi, fname, 0);
zero_base(exo);
} /* End of wave number loop */
} /* End of mode loop */
/* Successful completion */
return 1;
}
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);
}
/* Routines that handle the eigensolver.
*
* Linear stability analysis
* Solve J z = t M z
*
* where
*
* input:
* J = jacobian matrix
* M = mass or overlap matrix
*
* output:
* z = eigenvectors
* t = eigenvalues
*
* Friendly warning:
* Do not edit this unless you know what you are doing!!
*
* Originally written by Ian Gates
* pre-CVS modification history:
* - Sep 24, 1997, first checkin
* - Feb 98 -> Oct 98, another checkin
* - Jan 13, 2000, MMH rearranged and conformed to Goma style.
*/
void
eggrollwrap(int *istuff, /* info for eigenvalue extraction */
dbl *dstuff, /* info for eigenvalue extraction */
int *ija, /* column pointer array */
dbl *jac, /* nonzero array */
dbl *mas, /* nonzero array - same structure
as jac[] (ija[]) */
dbl *x, /* Value of the solution vector */
char *ExoFileOut, /* Name of exoII output file */
int prob_type,
dbl delta_t, /* time step size */
dbl theta, /* variable time integration parameter
explicit (theta = 1) to
implicit (theta = 0) */
dbl *x_old, /* Value of the old solution vector */
dbl *xdot, /* Value of xdot predicted for new
solution */
dbl *xdot_old, /* dx/dt at previous time step */
dbl *resid_vector,
int *converged, /* whether the Newton has converged */
int *nprint, /* counter for time step number */
int tnv, /* number of nodal results */
int tnv_post, /* number of post processing results */
struct Results_Description *rd,
int *gindex,
int *p_gsize,
dbl *gvec,
dbl time_value,
Exo_DB *exo, /* ptr to finite element mesh db */
int Num_Proc, /* number of processors used */
Dpi *dpi) /* ptr to distributed processing info */
{
int
i, j, ic,
nj, nnz_j,
first_linear_solver_call, Factor_Flag, matr_form,
error, rcflag, action,
ev_n, ev_jac,
filter,
mm, max_itr,
nev_want, nev_found, lead,
/* read_form, soln_tech, push_mode, */
push_mode,
init_shft, recycle;
dbl
stol, ivector,
dwork[20];
dbl
*ev_e, *ev_i, *ev_r, *ev_x,
*v1, *v2,
*mat,
**evect, **schur;
char save_ExoFileOut[MAX_FNL];
static int UMF_system_id; /* Used to uniquely identify the
* explicit fill system to solve from
* the other UMF systems. */
/* Initialize
*/
ic = error = rcflag = action = 0;
ev_jac = 0;
matr_form = 1;
/* Set values
*/
mm = istuff[0];
nj = istuff[1];
nnz_j = istuff[2];
filter = istuff[3];
recycle = istuff[4];
nev_want = istuff[6];
init_shft = istuff[7];
max_itr = istuff[8];
push_mode = istuff[9];
stol = dstuff[0];
ivector = dstuff[3];
printf(" Initializing variables and allocating space... ");
/* Allocate spectrum storage
*/
ev_e = Dvector_birth(mm+5);
ev_i = Dvector_birth(mm+5);
ev_r = Dvector_birth(mm+5);
ev_x = Dvector_birth(mm+5);
/* Set initial (real) shifts
*/
ev_n = init_shft;
vcopy(init_shft, &ev_r[0], 1.0, &dstuff[10]);
/* Allocate auxiliary work vectors
*/
mat = Dvector_birth(nnz_j+5);
/* Allocate eigenvectors and schur storage
*/
i = nj+5;
j = mm+5;
evect = Dmatrix_birth(j, i);
schur = Dmatrix_birth(j, i);
/* Allocate reverse communication vectors
*/
v1 = Dvector_birth(nj+5);
v2 = Dvector_birth(nj+5);
/* Check for something that seems to make no difference if it's on,
* except for occasionally causing seg faults... */
if(recycle != 0)
EH(-1, "Eigen recycle currently doesn't work, turn it off.");
/* Set initial vector
*/
vinit(nj, &v1[0], 0.5);
/* GEVP solution
*/
ic = 0;
first_linear_solver_call = +1;
do {
ic++;
/* printf("ic = %d\n", ic); fflush(stdout); */
gevp_solver_rc(nj, mm, max_itr, stol, filter, &ev_n, &ev_r[0],
&ev_i[0], &ev_e[0], &ev_x[0], &lead, ev_jac,
nev_want, &nev_found, schur, evect, recycle,
ivector, 0, &rcflag, &action, &dwork[0], &v1[0],
&v2[0]);
/* printf("action = %d\n", action); fflush(stdout); */
switch (action)
{
case 0: /* All done */
break;
case 1: /* v2 = J*v1 */
MV_MSR(&nj, &ija[0], &jac[0], &v1[0], &v2[0]);
break;
case 2: /* v2 = M*v1 */
MV_MSR(&nj, &ija[0], &mas[0], &v1[0], &v2[0]);
break;
case 3: /* inv(J-sM) */
/* Shift matrix step */
v2sum(nnz_j, &mat[0], 1.0, &jac[0], -dwork[0], &mas[0]);
/* Invert step - get LU for later */
if(first_linear_solver_call == 1)
{
Factor_Flag = -2;
UMF_system_id = -1;
}
else
Factor_Flag = -1;
/*
printf("Calling SL_UMF, first_linear_solver_call = %d, Factor_Flag = %d\n",
first_linear_solver_call, Factor_Flag); fflush(stdout);
*/
UMF_system_id = SL_UMF(UMF_system_id,
&first_linear_solver_call,
&Factor_Flag,
&matr_form,
&nj,
&nnz_j,
&ija[0],
&ija[0],
&mat[0],
&v1[0],
&v2[0]);
first_linear_solver_call = 0;
break;
case 4: /* v2 = inv(J-sM)*M*v1 */
Factor_Flag = 3;
if(first_linear_solver_call)
EH(-1, "Tried to transform eigenvectors before a solve!");
gevp_transformation(UMF_system_id, first_linear_solver_call,
Factor_Flag, matr_form, 1, nj, nnz_j,
&ija[0], &jac[0], &mas[0], &mat[0],
/* soln_tech, */
&v2[0], &v1[0], dwork[0], dwork[1]);
break;
default:
EH(-1, "Uh-oh! I shouldn't be here!");
break;
} /* switch(action) */
if (ic > 10000)
error = 1;
} while ((rcflag != 0) && (error == 0));
/* Error check
*/
if (error == 1)
{
puts(" E: Too many iterations. Escape. ");
exit(-1);
}
/* De-allocate solver storage
*/
first_linear_solver_call = -1;
/* MMH sez: If first_linear_solver_call == -1, then we want to
* deallocate memory so we shouldn't be trying to solve anything!
* This was FMR'ing b/c SL_UMF was being called with
* first_linear_solver_call = -1, and Factor_Flag = 3. Bad.
*/
Factor_Flag = -3;
UMF_system_id = SL_UMF(UMF_system_id,
&first_linear_solver_call,
&Factor_Flag,
&matr_form,
&nj,
&nnz_j,
ija,
ija,
mat,
&v1[0],
&v2[0]);
/* Display results
*/
printf("\n-------------------------------------------------------------------------------\n");
if(Linear_Stability == LSA_3D_OF_2D)
printf("NORMAL MODE WAVE NUMBER = %g\n", LSA_3D_of_2D_wave_number);
printf(" Eigensolver required %d iterations.\n",ic);
printf(" Found %d converged eigenvalues.\n", nev_found);
printf(" Leading Eigenvalue = % 10.6e%+10.6e i RES = % 10.6e\n",
ev_r[lead], ev_i[lead], ev_e[lead]);
printf(" Real Imag RES\n");
for (i=0;i<nev_found;i++)
printf(" % 10.6e %+10.6e i % 10.6e\n", ev_r[i], ev_i[i], ev_e[i]);
/* MMH: I know this is stupid, but the filename for the "regular"
* Exodus output is a global variable!!! It is required in
* post_process_nodal(). I swap it out here, and will swap it back
* when we're done with LSA. Why don't I just overwrite it
* completely you may ask? Well, I don't know if and/or when the
* code will continue to do something useful after LSA. If it ever
* does, then it would probably like to know what the correct output
* filename is. Kinda like camping: Leave with what you came in
* with. */
strncpy(save_ExoFileOut, ExoFileOut, MAX_FNL-1);
/* Write results to file (exoII format)
*/
printf(" push_mode = %12d \n", push_mode);
if (push_mode > 0)
{
puts(" Writing modes to file ...");
/* Write to exo file
* Each mode is written as a "time step" solution into exoII DB
*/
for(i = 0; i < push_mode; i++)
{
printf("\t\t Mode %4d ...", i);
if(LSA_3D_of_2D_wave_number == -1.0)
sprintf(ExoFileOut, "LSA_%d_of_%d_%s", i + 1, push_mode,
save_ExoFileOut);
else
sprintf(ExoFileOut, "LSA_%d_of_%d_wn=%g_%s", i + 1, push_mode,
LSA_3D_of_2D_wave_number, save_ExoFileOut);
/* Replicate basic mesh info */
one_base(exo);
wr_mesh_exo(exo, ExoFileOut, 0);
wr_result_prelim_exo(rd, exo, ExoFileOut, NULL);
/* Update exo file for distributed problem info
*/
if (Num_Proc > 1) {
wr_dpi(dpi, ExoFileOut, 0);
}
for (j = 0; j < tnv; j++) {
extract_nodal_vec(&evect[i][0], rd->nvtype[j], rd->nvkind[j],
rd->nvmatID[j], gvec, exo, FALSE, time_value);
wr_nodal_result_exo(exo, ExoFileOut, gvec, j+1, 1,
time_value);
}
/*
* Add additional user-specified post processing variables
*/
if (tnv_post > 0) {
post_process_nodal(&evect[i][0], NULL, x_old, xdot, xdot_old,
resid_vector, 1, &time_value, delta_t, 0.0,
NULL, exo, dpi, rd, ExoFileOut);
}
zero_base(exo);
printf(" recorded.\n");
}
}
/* MMH: See comments above. */
strncpy(ExoFileOut, save_ExoFileOut, MAX_FNL);
/* De-allocate work vectors
*/
printf("Deallocating memory ... ");
i = nj+5;
j = mm+5;
Dmatrix_death(schur, j, i);
Dmatrix_death(evect, j, i);
Dvector_death(&v2[0], nj+5);
Dvector_death(&v1[0], nj+5);
Dvector_death(&mat[0], nnz_j+5);
Dvector_death(&ev_e[0], mm+5);
Dvector_death(&ev_i[0], mm+5);
Dvector_death(&ev_r[0], mm+5);
Dvector_death(&ev_x[0], mm+5);
printf("done.\n");
}
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*/
}
