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*/ }