PFModule *WRFSelectTimeStepNewPublicXtra( double initial_step, double growth_factor, double max_step, double min_step) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra; Type1 *dummy1; public_xtra = ctalloc(PublicXtra, 1); public_xtra -> type = 1; dummy1 = ctalloc(Type1, 1); dummy1 -> initial_step = initial_step; dummy1 -> factor = growth_factor; dummy1 -> max_step = max_step; dummy1 -> min_step = min_step; (public_xtra -> data) = (void *) dummy1; PFModulePublicXtra(this_module) = public_xtra; return this_module; }
void WRFSelectTimeStepFreePublicXtra() { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module); Type0 *dummy0; Type1 *dummy1; if ( public_xtra ) { switch((public_xtra -> type)) { case 0: { dummy0 = (Type0 *)(public_xtra -> data); tfree(dummy0); break; } case 1: { dummy1 = (Type1 *)(public_xtra -> data); tfree(dummy1); break; } } tfree(public_xtra); } }
PFModule *NewPFModule( void *call, void *init_instance_xtra, void *free_instance_xtra, void *new_public_xtra, void *free_public_xtra, void *sizeof_temp_data, void *instance_xtra, void *public_xtra) { PFModule *new_module; new_module = talloc(PFModule, 1); (new_module -> call) = (void (*)())call; (new_module -> init_instance_xtra) = (void (*)())init_instance_xtra; (new_module -> free_instance_xtra) = (void (*)())free_instance_xtra; (new_module -> new_public_xtra) = (void (*)())new_public_xtra; (new_module -> free_public_xtra) = (void (*)())free_public_xtra; (new_module -> sizeof_temp_data) = (int (*)())sizeof_temp_data; PFModuleInstanceXtra(new_module) = instance_xtra; PFModulePublicXtra(new_module) = public_xtra; return new_module; }
PFModule *SelectTimeStepNewPublicXtra() { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra; Type0 *dummy0; Type1 *dummy1; char *switch_name; NameArray type_na; type_na = NA_NewNameArray("Constant Growth"); public_xtra = ctalloc(PublicXtra, 1); switch_name = GetString("TimeStep.Type"); public_xtra -> type = NA_NameToIndex(type_na, switch_name); switch((public_xtra -> type)) { case 0: { dummy0 = ctalloc(Type0, 1); dummy0 -> step = GetDouble("TimeStep.Value"); (public_xtra -> data) = (void *) dummy0; break; } case 1: { dummy1 = ctalloc(Type1, 1); dummy1 -> initial_step = GetDouble("TimeStep.InitialStep"); dummy1 -> factor = GetDouble("TimeStep.GrowthFactor"); dummy1 -> max_step = GetDouble("TimeStep.MaxStep"); dummy1 -> min_step = GetDouble("TimeStep.MinStep"); (public_xtra -> data) = (void *) dummy1; break; } default: { InputError("Error: invalid type <%s> for key <%s>\n", switch_name, "TimeStep.Type"); } } NA_FreeNameArray(type_na); PFModulePublicXtra(this_module) = public_xtra; return this_module; }
/*-------------------------------------------------------------------------- * InputPorosity *--------------------------------------------------------------------------*/ void InputPorosity( GeomSolid * geounit, GrGeomSolid *gr_geounit, Vector * field) { /*----------------------------------------------------------------------- * Local variables *-----------------------------------------------------------------------*/ PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module); double field_value = (public_xtra->field_value); Grid *grid = (instance_xtra->grid); Subgrid *subgrid; Subvector *field_sub; double *fieldp; int subgrid_loop; int i, j, k; int ix, iy, iz; int nx, ny, nz; int r; int index; (void)geounit; /*----------------------------------------------------------------------- * Assign constant values to field *-----------------------------------------------------------------------*/ /* extra variables for reading from file */ Type3 * dummy3; dummy3 = (Type3*)(public_xtra->data); Vector *ic_values = dummy3->ic_values; Subvector *ic_values_sub; double *ic_values_dat; for (subgrid_loop = 0; subgrid_loop < GridNumSubgrids(grid); subgrid_loop++) { subgrid = GridSubgrid(grid, subgrid_loop); field_sub = VectorSubvector(field, subgrid_loop); /* new subvector from file */ ic_values_sub = VectorSubvector(ic_values, subgrid_loop); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); /* RDF: assume resolution is the same in all 3 directions */ r = SubgridRX(subgrid); fieldp = SubvectorData(field_sub); /* new subvector data to read from */ ic_values_dat = SubvectorData(ic_values_sub); GrGeomInLoop(i, j, k, gr_geounit, r, ix, iy, iz, nx, ny, nz, { index = SubvectorEltIndex(field_sub, i, j, k); /* now assign the value from file to field */ // fieldp[index] = field_value; fieldp[index] = ic_values_dat[index]; }); }
PFModule *DupPFModule(PFModule *pf_module) { return NewPFModule((void *)(pf_module -> call), (void *)(pf_module -> init_instance_xtra), (void *)(pf_module -> free_instance_xtra), (void *)(pf_module -> new_public_xtra), (void *)(pf_module -> free_public_xtra), (void *)(pf_module -> sizeof_temp_data), PFModuleInstanceXtra(pf_module), PFModulePublicXtra(pf_module)); }
void KinsolNonlinSolverFreePublicXtra() { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); if (public_xtra) { if (public_xtra->richards_jacobian_eval != NULL) { PFModuleFreeModule(public_xtra->richards_jacobian_eval); } if (public_xtra->precond != NULL) { PFModuleFreeModule(public_xtra->precond); } PFModuleFreeModule(public_xtra->nl_function_eval); tfree(public_xtra); } }
void RichardsBCInternal( Problem *problem, ProblemData *problem_data, Vector *f, Matrix *A, double time, Vector *pressure, int fcn) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module); WellData *well_data = ProblemDataWellData(problem_data); WellDataPhysical *well_data_physical; WellDataValue *well_data_value; TimeCycleData *time_cycle_data; int num_conditions = (public_xtra -> num_conditions); int num_wells, total_num; Type0 *dummy0; Grid *grid = VectorGrid(pressure); SubgridArray *internal_bc_subgrids = NULL; Subgrid *subgrid, *subgrid_ind, *new_subgrid; Subvector *p_sub; double *pp; double *internal_bc_conditions = NULL; double dx, dy, dz; double value; int ix, iy, iz; int nx, ny, nz; int rx, ry, rz; int process; int i, j, k; int grid_index, well, index; int cycle_number, interval_number; int ip, im; /*-------------------------------------------------------------------- * gridify the internal boundary locations (should be done elsewhere?) *--------------------------------------------------------------------*/ if ( num_conditions > 0 ) { internal_bc_subgrids = NewSubgridArray(); internal_bc_conditions = ctalloc(double, num_conditions); for (i = 0; i < num_conditions;i++) { switch((public_xtra -> type[i])) { case 0: { dummy0 = (Type0 *)(public_xtra -> data[i]); ix = IndexSpaceX((dummy0 -> xlocation), 0); iy = IndexSpaceY((dummy0 -> ylocation), 0); iz = IndexSpaceZ((dummy0 -> zlocation), 0); nx = 1; ny = 1; nz = 1; rx = 0; ry = 0; rz = 0; process = amps_Rank(amps_CommWorld); new_subgrid = NewSubgrid(ix, iy, iz, nx, ny, nz, rx, ry, rz, process); AppendSubgrid(new_subgrid, internal_bc_subgrids); internal_bc_conditions[i] = (dummy0 -> value); break; } } } }
PFModule *KinsolNonlinSolverNewPublicXtra() { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra; char *switch_name; char key[IDB_MAX_KEY_LEN]; int switch_value; NameArray switch_na; NameArray verbosity_switch_na; NameArray eta_switch_na; NameArray globalization_switch_na; NameArray precond_switch_na; public_xtra = ctalloc(PublicXtra, 1); sprintf(key, "Solver.Nonlinear.ResidualTol"); (public_xtra->residual_tol) = GetDoubleDefault(key, 1e-7); sprintf(key, "Solver.Nonlinear.StepTol"); (public_xtra->step_tol) = GetDoubleDefault(key, 1e-7); sprintf(key, "Solver.Nonlinear.MaxIter"); (public_xtra->max_iter) = GetIntDefault(key, 15); sprintf(key, "Solver.Linear.KrylovDimension"); (public_xtra->krylov_dimension) = GetIntDefault(key, 10); sprintf(key, "Solver.Linear.MaxRestarts"); (public_xtra->max_restarts) = GetIntDefault(key, 0); verbosity_switch_na = NA_NewNameArray("NoVerbosity LowVerbosity " "NormalVerbosity HighVerbosity"); sprintf(key, "Solver.Nonlinear.PrintFlag"); switch_name = GetStringDefault(key, "LowVerbosity"); (public_xtra->print_flag) = NA_NameToIndex(verbosity_switch_na, switch_name); NA_FreeNameArray(verbosity_switch_na); eta_switch_na = NA_NewNameArray("EtaConstant Walker1 Walker2"); sprintf(key, "Solver.Nonlinear.EtaChoice"); switch_name = GetStringDefault(key, "Walker2"); switch_value = NA_NameToIndex(eta_switch_na, switch_name); switch (switch_value) { case 0: { public_xtra->eta_choice = ETACONSTANT; public_xtra->eta_value = GetDoubleDefault("Solver.Nonlinear.EtaValue", 1e-4); public_xtra->eta_alpha = 0.0; public_xtra->eta_gamma = 0.0; break; } case 1: { public_xtra->eta_choice = ETACHOICE1; public_xtra->eta_alpha = 0.0; public_xtra->eta_gamma = 0.0; break; } case 2: { public_xtra->eta_choice = ETACHOICE2; public_xtra->eta_alpha = GetDoubleDefault("Solver.Nonlinear.EtaAlpha", 2.0); public_xtra->eta_gamma = GetDoubleDefault("Solver.Nonlinear.EtaGamma", 0.9); public_xtra->eta_value = 0.0; break; } default: { InputError("Error: Invalid value <%s> for key <%s>\n", switch_name, key); } } NA_FreeNameArray(eta_switch_na); switch_na = NA_NewNameArray("False True"); sprintf(key, "Solver.Nonlinear.UseJacobian"); switch_name = GetStringDefault(key, "False"); switch_value = NA_NameToIndex(switch_na, switch_name); switch (switch_value) { case 0: { (public_xtra->matvec) = NULL; break; } case 1: { (public_xtra->matvec) = KINSolMatVec; break; } default: { InputError("Error: Invalid value <%s> for key <%s>\n", switch_name, key); } } NA_FreeNameArray(switch_na); sprintf(key, "Solver.Nonlinear.DerivativeEpsilon"); (public_xtra->derivative_epsilon) = GetDoubleDefault(key, 1e-7); globalization_switch_na = NA_NewNameArray("InexactNewton LineSearch"); sprintf(key, "Solver.Nonlinear.Globalization"); switch_name = GetStringDefault(key, "LineSearch"); switch_value = NA_NameToIndex(globalization_switch_na, switch_name); switch (switch_value) { case 0: { (public_xtra->globalization) = INEXACT_NEWTON; break; } case 1: { (public_xtra->globalization) = LINESEARCH; break; } default: { InputError("Error: Invalid value <%s> for key <%s>\n", switch_name, key); } } NA_FreeNameArray(globalization_switch_na); precond_switch_na = NA_NewNameArray("NoPC MGSemi SMG PFMG PFMGOctree"); sprintf(key, "Solver.Linear.Preconditioner"); switch_name = GetStringDefault(key, "MGSemi"); switch_value = NA_NameToIndex(precond_switch_na, switch_name); if (switch_value == 0) { (public_xtra->precond) = NULL; (public_xtra->pcinit) = NULL; (public_xtra->pcsolve) = NULL; } else if (switch_value > 0) { (public_xtra->precond) = PFModuleNewModuleType( KinsolPCNewPublicXtraInvoke, KinsolPC, (key, switch_name)); (public_xtra->pcinit) = (KINSpgmrPrecondFn)KINSolInitPC; (public_xtra->pcsolve) = (KINSpgmrPrecondSolveFn)KINSolCallPC; } else { InputError("Error: Invalid value <%s> for key <%s>\n", switch_name, key); } NA_FreeNameArray(precond_switch_na); public_xtra->nl_function_eval = PFModuleNewModule(NlFunctionEval, ()); public_xtra->neq = ((public_xtra->max_restarts) + 1) * (public_xtra->krylov_dimension); if (public_xtra->matvec != NULL) public_xtra->richards_jacobian_eval = PFModuleNewModuleType( RichardsJacobianEvalNewPublicXtraInvoke, RichardsJacobianEval, ("Solver.Nonlinear.Jacobian")); else public_xtra->richards_jacobian_eval = NULL; (public_xtra->time_index) = RegisterTiming("KINSol"); PFModulePublicXtra(this_module) = public_xtra; return this_module; }
PFModule *KinsolNonlinSolverInitInstanceXtra( Problem * problem, Grid * grid, ProblemData *problem_data, double * temp_data) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); InstanceXtra *instance_xtra; int neq = public_xtra->neq; int max_restarts = public_xtra->max_restarts; int krylov_dimension = public_xtra->krylov_dimension; int max_iter = public_xtra->max_iter; int print_flag = public_xtra->print_flag; int eta_choice = public_xtra->eta_choice; long int *iopt; double *ropt; double eta_value = public_xtra->eta_value; double eta_alpha = public_xtra->eta_alpha; double eta_gamma = public_xtra->eta_gamma; double derivative_epsilon = public_xtra->derivative_epsilon; Vector *fscale; Vector *uscale; State *current_state; KINSpgmruserAtimesFn matvec = public_xtra->matvec; KINSpgmrPrecondFn pcinit = public_xtra->pcinit; KINSpgmrPrecondSolveFn pcsolve = public_xtra->pcsolve; KINMem kin_mem; FILE *kinsol_file; char filename[255]; int i; if (PFModuleInstanceXtra(this_module) == NULL) instance_xtra = ctalloc(InstanceXtra, 1); else instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module); /*----------------------------------------------------------------------- * Initialize module instances *-----------------------------------------------------------------------*/ if (PFModuleInstanceXtra(this_module) == NULL) { if (public_xtra->precond != NULL) instance_xtra->precond = PFModuleNewInstanceType(KinsolPCInitInstanceXtraInvoke, public_xtra->precond, (problem, grid, problem_data, temp_data, NULL, NULL, NULL, 0, 0)); else instance_xtra->precond = NULL; instance_xtra->nl_function_eval = PFModuleNewInstanceType(NlFunctionEvalInitInstanceXtraInvoke, public_xtra->nl_function_eval, (problem, grid, temp_data)); if (public_xtra->richards_jacobian_eval != NULL) /* Initialize instance for nonsymmetric matrix */ instance_xtra->richards_jacobian_eval = PFModuleNewInstanceType(RichardsJacobianEvalInitInstanceXtraInvoke, public_xtra->richards_jacobian_eval, (problem, grid, problem_data, temp_data, 0)); else instance_xtra->richards_jacobian_eval = NULL; } else { if (instance_xtra->precond != NULL) PFModuleReNewInstanceType(KinsolPCInitInstanceXtraInvoke, instance_xtra->precond, (problem, grid, problem_data, temp_data, NULL, NULL, NULL, 0, 0)); PFModuleReNewInstanceType(NlFunctionEvalInitInstanceXtraInvoke, instance_xtra->nl_function_eval, (problem, grid, temp_data)); if (instance_xtra->richards_jacobian_eval != NULL) PFModuleReNewInstanceType(RichardsJacobianEvalInitInstanceXtraInvoke, instance_xtra->richards_jacobian_eval, (problem, grid, problem_data, temp_data, 0)); } /*----------------------------------------------------------------------- * Initialize KINSol input parameters and memory instance *-----------------------------------------------------------------------*/ if (PFModuleInstanceXtra(this_module) == NULL) { current_state = ctalloc(State, 1); /* Set up the grid data for the kinsol stuff */ SetPf2KinsolData(grid, 1); /* Initialize KINSol parameters */ sprintf(filename, "%s.%s", GlobalsOutFileName, "kinsol.log"); if (!amps_Rank(amps_CommWorld)) kinsol_file = fopen(filename, "w"); else kinsol_file = NULL; instance_xtra->kinsol_file = kinsol_file; /* Initialize KINSol memory */ kin_mem = (KINMem)KINMalloc(neq, kinsol_file, NULL); /* Initialize the gmres linear solver in KINSol */ KINSpgmr((void*)kin_mem, /* Memory allocated above */ krylov_dimension, /* Max. Krylov dimension */ max_restarts, /* Max. no. of restarts - 0 is none */ 1, /* Max. calls to PC Solve w/o PC Set */ pcinit, /* PC Set function */ pcsolve, /* PC Solve function */ matvec, /* ATimes routine */ current_state /* User data for PC stuff */ ); /* Initialize optional arguments for KINSol */ iopt = instance_xtra->int_optional_input; ropt = instance_xtra->real_optional_input; // Only print on rank 0 iopt[PRINTFL] = amps_Rank(amps_CommWorld) ? 0 : print_flag; iopt[MXITER] = max_iter; iopt[PRECOND_NO_INIT] = 0; iopt[NNI] = 0; iopt[NFE] = 0; iopt[NBCF] = 0; iopt[NBKTRK] = 0; iopt[ETACHOICE] = eta_choice; iopt[NO_MIN_EPS] = 0; ropt[MXNEWTSTEP] = 0.0; ropt[RELFUNC] = derivative_epsilon; ropt[RELU] = 0.0; ropt[FNORM] = 0.0; ropt[STEPL] = 0.0; ropt[ETACONST] = eta_value; ropt[ETAALPHA] = eta_alpha; /* Put in conditional assignment of eta_gamma since KINSOL aliases */ /* ETAGAMMA and ETACONST */ if (eta_value == 0.0) ropt[ETAGAMMA] = eta_gamma; /* Initialize iteration counts */ for (i = 0; i < OPT_SIZE; i++) instance_xtra->integer_outputs[i] = 0; /* Scaling vectors*/ uscale = NewVectorType(grid, 1, 1, vector_cell_centered); InitVectorAll(uscale, 1.0); instance_xtra->uscale = uscale; fscale = NewVectorType(grid, 1, 1, vector_cell_centered); InitVectorAll(fscale, 1.0); instance_xtra->fscale = fscale; instance_xtra->feval = KINSolFunctionEval; instance_xtra->kin_mem = kin_mem; instance_xtra->current_state = current_state; } PFModuleInstanceXtra(this_module) = instance_xtra; return this_module; }
int KinsolNonlinSolver(Vector *pressure, Vector *density, Vector *old_density, Vector *saturation, Vector *old_saturation, double t, double dt, ProblemData *problem_data, Vector *old_pressure, Vector *evap_trans, Vector *ovrl_bc_flx, Vector *x_velocity, Vector *y_velocity, Vector *z_velocity) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module); Matrix *jacobian_matrix = (instance_xtra->jacobian_matrix); Matrix *jacobian_matrix_C = (instance_xtra->jacobian_matrix_C); Vector *uscale = (instance_xtra->uscale); Vector *fscale = (instance_xtra->fscale); PFModule *nl_function_eval = instance_xtra->nl_function_eval; PFModule *richards_jacobian_eval = instance_xtra->richards_jacobian_eval; PFModule *precond = instance_xtra->precond; State *current_state = (instance_xtra->current_state); int globalization = (public_xtra->globalization); int neq = (public_xtra->neq); double residual_tol = (public_xtra->residual_tol); double step_tol = (public_xtra->step_tol); SysFn feval = (instance_xtra->feval); KINMem kin_mem = (instance_xtra->kin_mem); FILE *kinsol_file = (instance_xtra->kinsol_file); long int *integer_outputs = (instance_xtra->integer_outputs); long int *iopt = (instance_xtra->int_optional_input); double *ropt = (instance_xtra->real_optional_input); int ret = 0; StateFunc(current_state) = nl_function_eval; StateProblemData(current_state) = problem_data; StateTime(current_state) = t; StateDt(current_state) = dt; StateOldDensity(current_state) = old_density; StateOldPressure(current_state) = old_pressure; StateOldSaturation(current_state) = old_saturation; StateDensity(current_state) = density; StateSaturation(current_state) = saturation; StateJacEval(current_state) = richards_jacobian_eval; StateJac(current_state) = jacobian_matrix; StateJacC(current_state) = jacobian_matrix_C; //dok StatePrecond(current_state) = precond; StateEvapTrans(current_state) = evap_trans; /*sk*/ StateOvrlBcFlx(current_state) = ovrl_bc_flx; /*sk*/ StateXvel(current_state) = x_velocity; //jjb StateYvel(current_state) = y_velocity; //jjb StateZvel(current_state) = z_velocity; //jjb if (!amps_Rank(amps_CommWorld)) fprintf(kinsol_file, "\nKINSOL starting step for time %f\n", t); BeginTiming(public_xtra->time_index); ret = KINSol((void*)kin_mem, /* Memory allocated above */ neq, /* Dummy variable here */ pressure, /* Initial guess @ this was "pressure before" */ feval, /* Nonlinear function */ globalization, /* Globalization method */ uscale, /* Scalings for the variable */ fscale, /* Scalings for the function */ residual_tol, /* Stopping tolerance on func */ step_tol, /* Stop tol. for sucessive steps */ NULL, /* Constraints */ TRUE, /* Optional inputs */ iopt, /* Opt. integer inputs */ ropt, /* Opt. double inputs */ current_state /* User-supplied input */ ); EndTiming(public_xtra->time_index); integer_outputs[NNI] += iopt[NNI]; integer_outputs[NFE] += iopt[NFE]; integer_outputs[NBCF] += iopt[NBCF]; integer_outputs[NBKTRK] += iopt[NBKTRK]; integer_outputs[SPGMR_NLI] += iopt[SPGMR_NLI]; integer_outputs[SPGMR_NPE] += iopt[SPGMR_NPE]; integer_outputs[SPGMR_NPS] += iopt[SPGMR_NPS]; integer_outputs[SPGMR_NCFL] += iopt[SPGMR_NCFL]; if (!amps_Rank(amps_CommWorld)) PrintFinalStats(kinsol_file, iopt, integer_outputs); if (ret == KINSOL_SUCCESS || ret == KINSOL_INITIAL_GUESS_OK) { ret = 0; } return(ret); }
void SelectTimeStep( double *dt, /* Time step size */ char *dt_info, /* Character flag indicating what requirement chose the time step */ double time, Problem *problem, ProblemData *problem_data) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module); Type0 *dummy0; Type1 *dummy1; double well_dt, bc_dt; switch((public_xtra -> type)) { case 0: { double constant; dummy0 = (Type0 *)(public_xtra -> data); constant = (dummy0 -> step); (*dt) = constant; break; } /* End case 0 */ case 1: { double initial_step; double factor; double max_step; double min_step; dummy1 = (Type1 *)(public_xtra -> data); initial_step = (dummy1 -> initial_step); factor = (dummy1 -> factor); max_step = (dummy1 -> max_step); min_step = (dummy1 -> min_step); if ((*dt) == 0.0) { (*dt) = initial_step; } else { (*dt) = (*dt)*factor; if ((*dt) < min_step) (*dt) = min_step; if ((*dt) > max_step) (*dt) = max_step; } break; } /* End case 1 */ } /* End switch */ /*----------------------------------------------------------------- * Get delta t's for all wells and boundary conditions. *-----------------------------------------------------------------*/ well_dt = TimeCycleDataComputeNextTransition(problem, time, WellDataTimeCycleData(ProblemDataWellData(problem_data))); bc_dt = TimeCycleDataComputeNextTransition(problem, time, BCPressureDataTimeCycleData(ProblemDataBCPressureData(problem_data))); /*----------------------------------------------------------------- * Compute the new dt value based on time stepping criterion imposed * by the user or on system parameter changes. Indicate what * determined the value of `dt'. *-----------------------------------------------------------------*/ if ( well_dt <= 0.0 ) well_dt = (*dt); if ( bc_dt <= 0.0 ) bc_dt = (*dt); if ((*dt) > well_dt) { (*dt) = well_dt; (*dt_info) = 'w'; } else if ((*dt) > bc_dt) { (*dt) = bc_dt; (*dt_info) = 'b'; } else { (*dt_info) = 'p'; } }
void BCPhaseSaturation( Vector * saturation, int phase, GrGeomSolid *gr_domain) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); Type0 *dummy0; Type1 *dummy1; Type2 *dummy2; int num_patches = (public_xtra->num_patches); int *patch_indexes = (public_xtra->patch_indexes); int *input_types = (public_xtra->input_types); int *bc_types = (public_xtra->bc_types); Grid *grid = VectorGrid(saturation); SubgridArray *subgrids = GridSubgrids(grid); Subgrid *subgrid; Subvector *sat_sub; double *satp; BCStruct *bc_struct; int patch_index; int nx_v, ny_v, nz_v; int sx_v, sy_v, sz_v; int *fdir; int indx, ipatch, is, i, j, k, ival, iv, sv; /*----------------------------------------------------------------------- * Get an offset into the PublicXtra data *-----------------------------------------------------------------------*/ indx = (phase * num_patches); /*----------------------------------------------------------------------- * Set up bc_struct with NULL values component *-----------------------------------------------------------------------*/ bc_struct = NewBCStruct(subgrids, gr_domain, num_patches, patch_indexes, bc_types, NULL); /*----------------------------------------------------------------------- * Implement BC's *-----------------------------------------------------------------------*/ for (ipatch = 0; ipatch < num_patches; ipatch++) { patch_index = patch_indexes[ipatch]; ForSubgridI(is, subgrids) { subgrid = SubgridArraySubgrid(subgrids, is); sat_sub = VectorSubvector(saturation, is); nx_v = SubvectorNX(sat_sub); ny_v = SubvectorNY(sat_sub); nz_v = SubvectorNZ(sat_sub); sx_v = 1; sy_v = nx_v; sz_v = ny_v * nx_v; satp = SubvectorData(sat_sub); switch (input_types[indx + ipatch]) { case 0: { double constant; dummy0 = (Type0*)(public_xtra->data[indx + ipatch]); constant = (dummy0->constant); BCStructPatchLoop(i, j, k, fdir, ival, bc_struct, ipatch, is, { sv = 0; if (fdir[0]) sv = fdir[0] * sx_v; else if (fdir[1]) sv = fdir[1] * sy_v; else if (fdir[2]) sv = fdir[2] * sz_v; iv = SubvectorEltIndex(sat_sub, i, j, k); satp[iv ] = constant; satp[iv + sv] = constant; satp[iv + 2 * sv] = constant; }); break; } case 1: { double height; double lower; double upper; double z, dz2; dummy1 = (Type1*)(public_xtra->data[indx + ipatch]); height = (dummy1->height); lower = (dummy1->lower); upper = (dummy1->upper); dz2 = SubgridDZ(subgrid) / 2.0; BCStructPatchLoop(i, j, k, fdir, ival, bc_struct, ipatch, is, { sv = 0; if (fdir[0]) sv = fdir[0] * sx_v; else if (fdir[1]) sv = fdir[1] * sy_v; else if (fdir[2]) sv = fdir[2] * sz_v; iv = SubvectorEltIndex(sat_sub, i, j, k); z = RealSpaceZ(k, SubgridRZ(subgrid)) + fdir[2] * dz2; if (z <= height) { satp[iv ] = lower; satp[iv + sv] = lower; satp[iv + 2 * sv] = lower; } else { satp[iv ] = upper; satp[iv + sv] = upper; satp[iv + 2 * sv] = upper; } }); break; } case 2: { int ip, num_points; double *point; double *height; double lower; double upper; double x, y, z, dx2, dy2, dz2; double unitx, unity, line_min, line_length, xy, slope; double interp_height; dummy2 = (Type2*)(public_xtra->data[indx + ipatch]); num_points = (dummy2->num_points); point = (dummy2->point); height = (dummy2->height); lower = (dummy2->lower); upper = (dummy2->upper); dx2 = SubgridDX(subgrid) / 2.0; dy2 = SubgridDY(subgrid) / 2.0; dz2 = SubgridDZ(subgrid) / 2.0; /* compute unit direction vector for piecewise linear line */ unitx = (dummy2->xupper) - (dummy2->xlower); unity = (dummy2->yupper) - (dummy2->ylower); line_length = sqrt(unitx * unitx + unity * unity); unitx /= line_length; unity /= line_length; line_min = (dummy2->xlower) * unitx + (dummy2->ylower) * unity; BCStructPatchLoop(i, j, k, fdir, ival, bc_struct, ipatch, is, { sv = 0; if (fdir[0]) sv = fdir[0] * sx_v; else if (fdir[1]) sv = fdir[1] * sy_v; else if (fdir[2]) sv = fdir[2] * sz_v; iv = SubvectorEltIndex(sat_sub, i, j, k); x = RealSpaceX(i, SubgridRX(subgrid)) + fdir[0] * dx2; y = RealSpaceY(j, SubgridRY(subgrid)) + fdir[1] * dy2; z = RealSpaceZ(k, SubgridRZ(subgrid)) + fdir[2] * dz2; /* project center of BC face onto piecewise linear line */ xy = x * unitx + y * unity; xy = (xy - line_min) / line_length; /* find two neighboring points */ ip = 1; for (; ip < (num_points - 1); ip++) { if (xy < point[ip]) break; } /* compute the slope */ slope = ((height[ip] - height[ip - 1]) / (point[ip] - point[ip - 1])); interp_height = height[ip - 1] + slope * (xy - point[ip - 1]); if (z <= interp_height) { satp[iv ] = lower; satp[iv + sv] = lower; satp[iv + 2 * sv] = lower; } else { satp[iv ] = upper; satp[iv + sv] = upper; satp[iv + 2 * sv] = upper; } }); break; }
void PhaseDensity( int phase, /* Phase */ Vector *phase_pressure, /* Vector of phase pressures at each block */ Vector *density_v, /* Vector of return densities at each block */ double *pressure_d, /* Double array of pressures */ double *density_d, /* Double array return density */ int fcn) /* Flag determining what to calculate * fcn = CALCFCN => calculate the function value * fcn = CALCDER => calculate the function * derivative */ /* Module returns either a double array or Vector of densities. * If density_v is NULL, then a double array is returned. * This "overloading" was provided so that the density module written * for the Richards' solver modules would be backward compatible with * the Impes modules. */ { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module); Type0 *dummy0; Type1 *dummy1; Grid *grid; Subvector *p_sub; Subvector *d_sub; double *pp; double *dp; Subgrid *subgrid; int sg; int ix, iy, iz; int nx, ny, nz; int nx_p, ny_p, nz_p; int nx_d, ny_d, nz_d; int i, j, k, ip, id; switch((public_xtra -> type[phase])) { case 0: { double constant; dummy0 = (Type0 *)(public_xtra -> data[phase]); constant = (dummy0 -> constant); if ( density_v != NULL) { grid = VectorGrid(density_v); ForSubgridI(sg, GridSubgrids(grid)) { subgrid = GridSubgrid(grid, sg); d_sub = VectorSubvector(density_v, sg); ix = SubgridIX(subgrid) - 1; iy = SubgridIY(subgrid) - 1; iz = SubgridIZ(subgrid) - 1; nx = SubgridNX(subgrid) + 2; ny = SubgridNY(subgrid) + 2; nz = SubgridNZ(subgrid) + 2; nx_d = SubvectorNX(d_sub); ny_d = SubvectorNY(d_sub); nz_d = SubvectorNZ(d_sub); dp = SubvectorElt(d_sub, ix, iy, iz); id = 0; if ( fcn == CALCFCN ) { BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz, id, nx_d, ny_d, nz_d, 1, 1, 1, { dp[id] = constant; }); }
void XSlope( ProblemData *problem_data, Vector * x_slope, Vector * dummy) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module); Grid *grid3d = instance_xtra->grid3d; GrGeomSolid *gr_solid, *gr_domain; Type0 *dummy0; Type1 *dummy1; Type2 *dummy2; Type3 *dummy3; VectorUpdateCommHandle *handle; SubgridArray *subgrids = GridSubgrids(grid3d); Subgrid *subgrid; Subvector *ps_sub; Subvector *sx_values_sub; double *data; double *psdat, *sx_values_dat; //double slopex[60][32][392]; int ix, iy, iz; int nx, ny, nz; int r; int is, i, j, k, ips, ipicv; double time = 0.0; (void)dummy; /*----------------------------------------------------------------------- * Put in any user defined sources for this phase *-----------------------------------------------------------------------*/ InitVectorAll(x_slope, 0.0); switch ((public_xtra->type)) { case 0: { int num_regions; int *region_indices; double *values; double x, y, z; double value; int ir; dummy0 = (Type0*)(public_xtra->data); num_regions = (dummy0->num_regions); region_indices = (dummy0->region_indices); values = (dummy0->values); for (ir = 0; ir < num_regions; ir++) { gr_solid = ProblemDataGrSolid(problem_data, region_indices[ir]); value = values[ir]; ForSubgridI(is, subgrids) { subgrid = SubgridArraySubgrid(subgrids, is); ps_sub = VectorSubvector(x_slope, is); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); /* RDF: assume resolution is the same in all 3 directions */ r = SubgridRX(subgrid); /* * TODO * SGS this does not match the loop in nl_function_eval. That * loop is going over more than the inner geom locations. Is that * important? Originally the x_slope array was not being allocated * by ctalloc, just alloc and unitialized memory reads were being * caused. Switched that to be ctalloc to init to 0 to "hack" a * fix but is this really a sign of deeper indexing problems? */ /* @RMM: todo. the looping to set slopes only goes over interior nodes * not ALL nodes (including ghost) as in nl fn eval and now the overland eval * routines. THis is fine in the KW approximation which only needs interior values * but for diffusive wave and for the terrain following grid (which uses the surface * topo slopes as subsurface slopes) this can cuase bddy problems. */ data = SubvectorData(ps_sub); GrGeomInLoop(i, j, k, gr_solid, r, ix, iy, iz, nx, ny, nz, { ips = SubvectorEltIndex(ps_sub, i, j, 0); x = RealSpaceX(i, SubgridRX(subgrid)); //data[ips] = sin(x)/8.0 + (1/8)*pow(x,-(7/8)) +sin(x/5.0)/(5.0*8.0); data[ips] = value; }); } } break; } /* End case 0 */
void PGSRF( GeomSolid * geounit, GrGeomSolid *gr_geounit, Vector * field, RFCondData * cdata) { /*-----------------* * Local variables * *-----------------*/ PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module); /* Input parameters (see PGSRFNewPublicXtra() below) */ double lambdaX = (public_xtra->lambdaX); double lambdaY = (public_xtra->lambdaY); double lambdaZ = (public_xtra->lambdaZ); double mean = (public_xtra->mean); double sigma = (public_xtra->sigma); int dist_type = (public_xtra->dist_type); double low_cutoff = (public_xtra->low_cutoff); double high_cutoff = (public_xtra->high_cutoff); int max_search_rad = (public_xtra->max_search_rad); int max_npts = (public_xtra->max_npts); int max_cpts = (public_xtra->max_cpts); Vector *tmpRF = NULL; /* Conditioning data */ int nc = (cdata->nc); double *x = (cdata->x); double *y = (cdata->y); double *z = (cdata->z); double *v = (cdata->v); /* Grid parameters */ Grid *grid = (instance_xtra->grid); Subgrid *subgrid; Subvector *sub_field; Subvector *sub_tmpRF; int NX, NY, NZ; /* Subgrid parameters */ int nx, ny, nz; double dx, dy, dz; int nx_v, ny_v, nz_v; int nx_v2, ny_v2, nz_v2; int nxG, nyG, nzG; /* Counters, indices, flags */ int gridloop; int i, j, k, n, m; int ii, jj, kk; int i2, j2, k2; int imin, jmin, kmin; int rpx, rpy, rpz; int npts; int index1, index2, index3; /* Spatial variables */ double *fieldp; double *tmpRFp; int iLx, iLy, iLz; /* Correlation length in terms of grid points */ int iLxp1, iLyp1, iLzp1; /* One more than each of the above */ int nLx, nLy, nLz; /* Size of correlation neighborhood in grid pts. */ int iLxyz; /* iLxyz = iLx*iLy*iLz */ int nLxyz; /* nLxyz = nLx*nLy*nLz */ int ix, iy, iz; int ref; int ix2, iy2, iz2; int i_search, j_search, k_search; int ci_search, cj_search, ck_search; double X0, Y0, Z0; /* Variables used in kriging algorithm */ double cmean, csigma; /* Conditional mean and std. dev. from kriging */ double A; double *A_sub; /* Sub-covariance matrix for external cond pts */ double *A11; /* Submatrix; note that A11 is 1-dim */ double **A12, **A21, **A22;/* Submatrices for external conditioning data */ double **M; /* Used as a temporary matrix */ double *b; /* Covariance vector for conditioning points */ double *b_tmp, *b2; double *w, *w_tmp; /* Solution vector to Aw=b */ int *ixx, *iyy, *izz; double *value; int di, dj, dk; double uni, gau; double ***cov; int ierr; /* Conditioning data variables */ int cpts; /* N cond pts for a single simulated node */ double *cval; /* Values for cond data for single node */ /* Communications */ VectorUpdateCommHandle *handle; int update_mode; /* Miscellaneous variables */ int **rand_path; char ***marker; int p, r, modulus; double a1, a2, a3; double cx, cy, cz; double sum; // FIXME Shouldn't we get this from numeric_limits? double Tiny = 1.0e-12; (void)geounit; /*----------------------------------------------------------------------- * Allocate temp vectors *-----------------------------------------------------------------------*/ tmpRF = NewVectorType(instance_xtra->grid, 1, max_search_rad, vector_cell_centered); /*----------------------------------------------------------------------- * Start sequential Gaussian simulator algorithm *-----------------------------------------------------------------------*/ /* Begin timing */ BeginTiming(public_xtra->time_index); /* initialize random number generators */ SeedRand(public_xtra->seed); /* For now, we will assume that all subgrids have the same uniform spacing */ subgrid = GridSubgrid(grid, 0); dx = SubgridDX(subgrid); dy = SubgridDY(subgrid); dz = SubgridDZ(subgrid); /* Size of search neighborhood through which random path must be defined */ iLx = (int)(lambdaX / dx); iLy = (int)(lambdaY / dy); iLz = (int)(lambdaZ / dz); /* For computational efficiency, we'll limit the * size of the search neighborhood. */ if (iLx > max_search_rad) iLx = max_search_rad; if (iLy > max_search_rad) iLy = max_search_rad; if (iLz > max_search_rad) iLz = max_search_rad; iLxp1 = iLx + 1; iLyp1 = iLy + 1; iLzp1 = iLz + 1; iLxyz = iLxp1 * iLyp1 * iLzp1; /* Define the size of a correlation neighborhood */ nLx = 2 * iLx + 1; nLy = 2 * iLy + 1; nLz = 2 * iLz + 1; nLxyz = nLx * nLy * nLz; /*------------------------ * Define a random path through the points in this subgrid. * The random path generation procedure of Srivastava and * Gomez has been adopted in this subroutine. A linear * congruential generator of the form: r(i) = 5*r(i-1)+1 mod(2**n) * has a cycle length of 2**n. By choosing the smallest power of * 2 that is still larger than the total number of points to be * simulated, the method ensures that all indices will be * generated once and only once. *------------------------*/ rand_path = talloc(int*, iLxyz); for (i = 0; i < iLxyz; i++) rand_path[i] = talloc(int, 3); modulus = 2; while (modulus < iLxyz + 1) modulus *= 2; /* Compute a random starting node */ p = (int)Rand(); r = 1 + p * (iLxyz - 1); k = (r - 1) / (iLxp1 * iLyp1); j = (r - 1 - iLxp1 * iLyp1 * k) / iLxp1; i = (r - 1) - (k * iLyp1 + j) * iLxp1; rand_path[0][2] = k; rand_path[0][1] = j; rand_path[0][0] = i; /* Determine the next nodes */ for (n = 1; n < iLxyz; n++) { r = (5 * r + 1) % modulus; while ((r < 1) || (r > iLxyz)) r = (5 * r + 1) % modulus; k = ((r - 1) / (iLxp1 * iLyp1)); j = (((r - 1) - iLxp1 * iLyp1 * k) / iLxp1); i = (r - 1) - (k * iLyp1 + j) * iLxp1; rand_path[n][0] = i; rand_path[n][1] = j; rand_path[n][2] = k; } /*----------------------------------------------------------------------- * Compute correlation lookup table *-----------------------------------------------------------------------*/ /* First compute a covariance lookup table */ cov = talloc(double**, nLx); for (i = 0; i < nLx; i++) { cov[i] = talloc(double*, nLy); for (j = 0; j < nLy; j++) cov[i][j] = ctalloc(double, nLz); } /* Note that in the construction of the covariance matrix * the max_search_rad is not used. Covariance depends upon * the correlation lengths, lambdaX/Y/Z, and the grid spacing. * The max_search_rad can be longer or shorter than the correlation * lengths. The bigger the search radius, the more accurately * the random field will match the correlation structure of the * covariance function. But the run time will increase greatly * as max_search_rad gets bigger because of the kriging matrix * that must be solved (see below). */ cx = 0.0; cy = 0.0; cz = 0.0; if (lambdaX != 0.0) cx = dx * dx / (lambdaX * lambdaX); if (lambdaY != 0.0) cy = dy * dy / (lambdaY * lambdaY); if (lambdaZ != 0.0) cz = dz * dz / (lambdaZ * lambdaZ); for (k = 0; k < nLz; k++) for (j = 0; j < nLy; j++) for (i = 0; i < nLx; i++) { a1 = i * i * cx; a2 = j * j * cy; a3 = k * k * cz; cov[i][j][k] = exp(-sqrt(a1 + a2 + a3)); } /* Allocate memory for variables that will be used in kriging */ A11 = ctalloc(double, nLxyz * nLxyz); A_sub = ctalloc(double, nLxyz * nLxyz); A12 = ctalloc(double*, nLxyz); A21 = ctalloc(double*, nLxyz); A22 = ctalloc(double*, nLxyz); M = ctalloc(double*, nLxyz); for (i = 0; i < nLxyz; i++) { A12[i] = ctalloc(double, nLxyz); A21[i] = ctalloc(double, nLxyz); A22[i] = ctalloc(double, nLxyz); M[i] = ctalloc(double, nLxyz); } b = ctalloc(double, nLxyz); b2 = ctalloc(double, nLxyz); b_tmp = ctalloc(double, nLxyz); w = ctalloc(double, nLxyz); w_tmp = ctalloc(double, nLxyz); value = ctalloc(double, nLxyz); cval = ctalloc(double, nLxyz); ixx = ctalloc(int, nLxyz); iyy = ctalloc(int, nLxyz); izz = ctalloc(int, nLxyz); /* Allocate space for the "marker" used to keep track of which * points in a representative correlation box have been simulated * already. */ marker = talloc(char**, (3 * iLx + 1)); marker += iLx; for (i = -iLx; i <= 2 * iLx; i++) { marker[i] = talloc(char*, (3 * iLy + 1)); marker[i] += iLy; for (j = -iLy; j <= 2 * iLy; j++) { marker[i][j] = ctalloc(char, (3 * iLz + 1)); marker[i][j] += iLz; for (k = -iLz; k <= 2 * iLz; k++) marker[i][j][k] = 0; } } /* Convert the cutoff values to a gaussian if they're lognormal on input */ if ((dist_type == 1) || (dist_type == 3)) { if (low_cutoff <= 0.0) { low_cutoff = Tiny; } else { low_cutoff = (log(low_cutoff / mean)) / sigma; } if (high_cutoff <= 0.0) { high_cutoff = DBL_MAX; } else { high_cutoff = (log(high_cutoff / mean)) / sigma; } } /*-------------------------------------------------------------------- * Start pGs algorithm *--------------------------------------------------------------------*/ for (gridloop = 0; gridloop < GridNumSubgrids(grid); gridloop++) { subgrid = GridSubgrid(grid, gridloop); sub_tmpRF = VectorSubvector(tmpRF, gridloop); sub_field = VectorSubvector(field, gridloop); tmpRFp = SubvectorData(sub_tmpRF); fieldp = SubvectorData(sub_field); X0 = RealSpaceX(0, SubgridRX(subgrid)); Y0 = RealSpaceY(0, SubgridRY(subgrid)); Z0 = RealSpaceZ(0, SubgridRZ(subgrid)); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); NX = ix + nx; NY = iy + ny; NZ = iz + nz; /* RDF: assume resolution is the same in all 3 directions */ ref = SubgridRX(subgrid); nx_v = SubvectorNX(sub_field); ny_v = SubvectorNY(sub_field); nz_v = SubvectorNZ(sub_field); nx_v2 = SubvectorNX(sub_tmpRF); ny_v2 = SubvectorNY(sub_tmpRF); nz_v2 = SubvectorNZ(sub_tmpRF); /* Initialize tmpRF vector */ GrGeomInLoop(i, j, k, gr_geounit, ref, ix, iy, iz, nx, ny, nz, { index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); tmpRFp[index2] = 0.0; }); /* Convert conditioning data to N(0,1) distribution if * it's assumed to be lognormal. Then copy it into tmpRFp */ if ((dist_type == 1) || (dist_type == 3)) { for (n = 0; n < nc; n++) { i = (int)((x[n] - X0) / dx + 0.5); j = (int)((y[n] - Y0) / dy + 0.5); k = (int)((z[n] - Z0) / dz + 0.5); if ((ix - max_search_rad <= i && i <= ix + nx + max_search_rad) && (iy - max_search_rad <= j && j <= iy + ny + max_search_rad) && (iz - max_search_rad <= k && k <= iz + nz + max_search_rad)) { index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); if (v[n] <= 0.0) tmpRFp[index2] = Tiny; else tmpRFp[index2] = (log(v[n] / mean)) / sigma; } } } /* Otherwise, shift data to N(0,1) distribution */ else { for (n = 0; n < nc; n++) { i = (int)((x[n] - X0) / dx + 0.5); j = (int)((y[n] - Y0) / dy + 0.5); k = (int)((z[n] - Z0) / dz + 0.5); if ((ix - max_search_rad <= i && i <= ix + nx + max_search_rad) && (iy - max_search_rad <= j && j <= iy + ny + max_search_rad) && (iz - max_search_rad <= k && k <= iz + nz + max_search_rad)) { index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); tmpRFp[index2] = (v[n] - mean) / sigma; } } } /* Set the search radii in each direction. If the maximum * number of points in a neighborhood is exceeded, these limits * will be reduced. */ i_search = iLx; j_search = iLy; k_search = iLz; /* Compute values at all points using all templates */ for (n = 0; n < iLxyz; n++) { /* Update the ghost layer before proceeding */ if (n > 0) { /* First reset max_search_radius */ max_search_rad = i_search; if (j_search > max_search_rad) max_search_rad = j_search; if (k_search > max_search_rad) max_search_rad = k_search; /* Reset the comm package based on the new max_search_radius */ if (max_search_rad == 1) update_mode = VectorUpdatePGS1; else if (max_search_rad == 2) update_mode = VectorUpdatePGS2; else if (max_search_rad == 3) update_mode = VectorUpdatePGS3; else update_mode = VectorUpdatePGS4; handle = InitVectorUpdate(tmpRF, update_mode); FinalizeVectorUpdate(handle); } rpx = rand_path[n][0]; rpy = rand_path[n][1]; rpz = rand_path[n][2]; ix2 = rpx; while (ix2 < ix) ix2 += iLxp1; iy2 = rpy; while (iy2 < iy) iy2 += iLyp1; iz2 = rpz; while (iz2 < iz) iz2 += iLzp1; /* This if clause checks to see if there are, in fact, * any points at all in this subgrid, for this * particular region. Note that each value of n in the * above n-loop corresponds to a different region. */ if ((ix2 < ix + nx) && (iy2 < iy + ny) && (iz2 < iz + nz)) { /* * Construct the input matrix and vector for kriging, * solve the linear system, and compute csigma. * These depend only on the spatial distribution of * conditioning data, not on the actual values of * the data. Only the conditional mean (cmean) depends * on actual values, so it must be computed for every * point. Thus, it's found within the pgs_Boxloop below. * The size of the linear system that must be solved here * will be no larger than (2r+1)^3, where r=max_search_rad. * It is clear from this why it is necessary to limit * the size of the search radius. */ /* Here the marker array indicates which points within * the search radius have been simulated already. This * spatial pattern of conditioning points will be the * same for every point in the current template. Thus, * this system can be solved once *outside* of the * GrGeomInLoop2 below. */ npts = 9999; while (npts > max_npts) { m = 0; /* Count the number of points in search ellipse */ for (k = rpz - k_search; k <= rpz + k_search; k++) for (j = rpy - j_search; j <= rpy + j_search; j++) for (i = rpx - i_search; i <= rpx + i_search; i++) { if (marker[i][j][k]) { ixx[m] = i; iyy[m] = j; izz[m++] = k; } } npts = m; /* If npts is too large, reduce the size of the * search ellipse one axis at a time. */ if (npts > max_npts) { /* If i_search is the biggest, reduce it by one. */ if ((i_search >= j_search) && (i_search >= k_search)) { i_search--; } /* Or, if j_search is the biggest, reduce it by one. */ else if ((j_search >= i_search) && (j_search >= k_search)) { j_search--; } /* Otherwise, reduce k_search by one. */ else { k_search--; } } } m = 0; for (j = 0; j < npts; j++) { di = abs(rpx - ixx[j]); dj = abs(rpy - iyy[j]); dk = abs(rpz - izz[j]); b[j] = cov[di][dj][dk]; for (i = 0; i < npts; i++) { di = abs(ixx[i] - ixx[j]); dj = abs(iyy[i] - iyy[j]); dk = abs(izz[i] - izz[j]); A11[m++] = cov[di][dj][dk]; } } /* Solve the linear system */ for (i = 0; i < npts; i++) w[i] = b[i]; if (npts > 0) { dpofa_(A11, &npts, &npts, &ierr); dposl_(A11, &npts, &npts, w); } /* Compute the conditional standard deviation for the RV * to be simulated. */ csigma = 0.0; for (i = 0; i < npts; i++) csigma += w[i] * b[i]; csigma = sqrt(cov[0][0][0] - csigma); /* The following loop hits every point in the current * region. That is, it skips by max_search_rad+1 * through the subgrid. In this way, all the points * in this loop may simulated simultaneously; each is * outside the search radius of all the others. */ nxG = (nx + ix); nyG = (ny + iy); nzG = (nz + iz); for (k = iz2; k < nzG; k += iLzp1) for (j = iy2; j < nyG; j += iLyp1) for (i = ix2; i < nxG; i += iLxp1) { index1 = SubvectorEltIndex(sub_field, i, j, k); index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); /* Only simulate points in this geounit and that don't * already have a value. If a node already has a value, * it was assigned as external conditioning data, * so we don't need to simulate it. */ if (fabs(tmpRFp[index2]) < Tiny) { /* Condition the random variable */ m = 0; cpts = 0; for (kk = -k_search; kk <= k_search; kk++) for (jj = -j_search; jj <= j_search; jj++) for (ii = -i_search; ii <= i_search; ii++) { value[m] = 0.0; index3 = SubvectorEltIndex(sub_tmpRF, i + ii, j + jj, k + kk); if (marker[ii + rpx][jj + rpy][kk + rpz]) { value[m++] = tmpRFp[index3]; } /* In this case, there is a value at this point, * but it wasn't simulated yet (as indicated by the * fact that the marker has no place for it). Thus, * it must be external conditioning data. */ else if (fabs(tmpRFp[index3]) > Tiny) { ixx[npts + cpts] = rpx + ii; iyy[npts + cpts] = rpy + jj; izz[npts + cpts] = rpz + kk; cval[cpts++] = tmpRFp[index3]; } } /* If cpts is too large, reduce the size of the * search neighborhood, one axis at a time. */ /* Define the size of the search neighborhood */ ci_search = i_search; cj_search = j_search; ck_search = k_search; while (cpts > max_cpts) { /* If ci_search is the biggest, reduce it by one. */ if ((ci_search >= cj_search) && (ci_search >= ck_search)) ci_search--; /* Or, if cj_search is the biggest, reduce it by one. */ else if ((cj_search >= ci_search) && (cj_search >= ck_search)) cj_search--; /* Otherwise, reduce ck_search by one. */ else ck_search--; /* Now recount the conditioning data points */ m = 0; cpts = 0; for (kk = -ck_search; kk <= ck_search; kk++) for (jj = -cj_search; jj <= cj_search; jj++) for (ii = -ci_search; ii <= ci_search; ii++) { index3 = SubvectorEltIndex(sub_tmpRF, i + ii, j + jj, k + kk); if (!(marker[rpx + ii][rpy + jj][rpz + kk]) && (fabs(tmpRFp[index3]) > Tiny)) { ixx[npts + cpts] = rpx + ii; iyy[npts + cpts] = rpy + jj; izz[npts + cpts] = rpz + kk; cval[cpts++] = tmpRFp[index3]; } } } for (i2 = 0; i2 < npts; i2++) w_tmp[i2] = w[i2]; /*-------------------------------------------------- * Conditioning to external data is done here. *--------------------------------------------------*/ if (cpts > 0) { /* Compute the submatrices */ for (j2 = 0; j2 < npts + cpts; j2++) { di = abs(rpx - ixx[j2]); dj = abs(rpy - iyy[j2]); dk = abs(rpz - izz[j2]); b[j2] = cov[di][dj][dk]; for (i2 = 0; i2 < npts + cpts; i2++) { di = abs(ixx[i2] - ixx[j2]); dj = abs(iyy[i2] - iyy[j2]); dk = abs(izz[i2] - izz[j2]); A = cov[di][dj][dk]; if (i2 < npts && j2 >= npts) A12[i2][j2 - npts] = A; if (i2 >= npts && j2 < npts) A21[i2 - npts][j2] = A; if (i2 >= npts && j2 >= npts) A22[i2 - npts][j2 - npts] = A; } } /* Compute b2' = b2 - A21 * A11_inv * b1 and augment b1 */ for (i2 = 0; i2 < cpts; i2++) b2[i2] = b[i2 + npts]; for (i2 = 0; i2 < npts; i2++) b_tmp[i2] = b[i2]; dposl_(A11, &npts, &npts, b_tmp); for (i2 = 0; i2 < cpts; i2++) { sum = 0.0; for (j2 = 0; j2 < npts; j2++) { sum += A21[i2][j2] * b_tmp[j2]; } b2[i2] -= sum; } for (i2 = 0; i2 < cpts; i2++) b[i2 + npts] = b2[i2]; /* Compute A22' = A22 - A21 * A11_inv * A12 */ for (j2 = 0; j2 < cpts; j2++) for (i2 = 0; i2 < npts; i2++) M[j2][i2] = A12[i2][j2]; if (npts > 0) { for (i2 = 0; i2 < cpts; i2++) dposl_(A11, &npts, &npts, M[i2]); } for (j2 = 0; j2 < cpts; j2++) for (i2 = 0; i2 < cpts; i2++) { sum = 0.0; for (k2 = 0; k2 < npts; k2++) sum += A21[i2][k2] * M[j2][k2]; A22[i2][j2] -= sum; } m = 0; for (j2 = 0; j2 < cpts; j2++) for (i2 = 0; i2 < cpts; i2++) A_sub[m++] = A22[i2][j2]; /* Compute x2 where A22*x2 = b2' */ dpofa_(A_sub, &cpts, &cpts, &ierr); dposl_(A_sub, &cpts, &cpts, b2); /* Compute w_tmp where A11*w_tmp = (b1 - A12*b2) */ if (npts > 0) { for (i2 = 0; i2 < npts; i2++) { sum = 0.0; for (k2 = 0; k2 < cpts; k2++) sum += A12[i2][k2] * b2[k2]; w_tmp[i2] = b[i2] - sum; } dposl_(A11, &npts, &npts, w_tmp); } /* Fill in the rest of w_tmp with b2 */ for (i2 = npts; i2 < npts + cpts; i2++) { w_tmp[i2] = b2[i2]; value[i2] = cval[i2 - npts]; } /* Recompute csigma */ csigma = 0.0; for (i2 = 0; i2 < npts + cpts; i2++) csigma += w_tmp[i2] * b[i2]; csigma = sqrt(cov[0][0][0] - csigma); } /*-------------------------------------------------- * End of external conditioning *--------------------------------------------------*/ cmean = 0.0; for (m = 0; m < npts + cpts; m++) cmean += w_tmp[m] * value[m]; /* uni = fieldp[index1]; */ uni = Rand(); gauinv_(&uni, &gau, &ierr); tmpRFp[index2] = csigma * gau + cmean; /* Cutoff tail values if required */ if (dist_type > 1) { if (tmpRFp[index2] < low_cutoff) tmpRFp[index2] = low_cutoff; if (tmpRFp[index2] > high_cutoff) tmpRFp[index2] = high_cutoff; } } /* if( abs(tmpRFp[index2]) < Tiny ) */ } /* end of triple for-loops over i,j,k */ /* Update the marker vector */ imin = rpx - iLxp1; if (imin < -iLx) imin += iLxp1; jmin = rpy - iLyp1; if (jmin < -iLy) jmin += iLyp1; kmin = rpz - iLzp1; if (kmin < -iLz) kmin += iLzp1; for (kk = kmin; kk <= 2 * iLz; kk += iLzp1) for (jj = jmin; jj <= 2 * iLy; jj += iLyp1) for (ii = imin; ii <= 2 * iLx; ii += iLxp1) { marker[ii][jj][kk] = 1; } } /* if(...) */ } /* n loop */ /* Make log-normal if requested. Note that low * and high cutoffs are already accomplished. */ if ((dist_type == 1) || (dist_type == 3)) { GrGeomInLoop(i, j, k, gr_geounit, ref, ix, iy, iz, nx, ny, nz, { index1 = SubvectorEltIndex(sub_field, i, j, k); index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); fieldp[index1] = mean * exp((sigma) * tmpRFp[index2]); });
void ICPhaseSatur( Vector *ic_phase_satur, int phase, ProblemData *problem_data) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module); Grid *grid = VectorGrid(ic_phase_satur); Type0 *dummy0; SubgridArray *subgrids = GridSubgrids(grid); Subgrid *subgrid; Subvector *ps_sub; double *data; int ix, iy, iz; int nx, ny, nz; int r; double field_sum; int is, i, j, k, ips; /*----------------------------------------------------------------------- * Initial saturation conditions for this phase *-----------------------------------------------------------------------*/ InitVector(ic_phase_satur, 0.0); switch((public_xtra -> type[phase])) { case 0: { int num_regions; int *region_indices; double *values; GrGeomSolid *gr_solid; double value; int ir; dummy0 = (Type0 *)(public_xtra -> data[phase]); num_regions = (dummy0 -> num_regions); region_indices = (dummy0 -> region_indices); values = (dummy0 -> values); for (ir = 0; ir < num_regions; ir++) { gr_solid = ProblemDataGrSolid(problem_data, region_indices[ir]); value = values[ir]; ForSubgridI(is, subgrids) { subgrid = SubgridArraySubgrid(subgrids, is); ps_sub = VectorSubvector(ic_phase_satur, is); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); /* RDF: assume resolution is the same in all 3 directions */ r = SubgridRX(subgrid); data = SubvectorData(ps_sub); GrGeomInLoop(i, j, k, gr_solid, r, ix, iy, iz, nx, ny, nz, { ips = SubvectorEltIndex(ps_sub, i, j, k); data[ips] = value; }); } } break; }
void PFMG( Vector *soln, Vector *rhs, double tol, int zero) { (void)zero; #ifdef HAVE_HYPRE PFModule *this_module = ThisPFModule; InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module); PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); HYPRE_StructMatrix hypre_mat = instance_xtra->hypre_mat; HYPRE_StructVector hypre_b = instance_xtra->hypre_b; HYPRE_StructVector hypre_x = instance_xtra->hypre_x; HYPRE_StructSolver hypre_pfmg_data = instance_xtra->hypre_pfmg_data; Grid *grid = VectorGrid(rhs); Subgrid *subgrid; int sg; Subvector *rhs_sub; Subvector *soln_sub; double *rhs_ptr; double *soln_ptr; double value; int index[3]; int ix, iy, iz; int nx, ny, nz; int nx_v, ny_v, nz_v; int i, j, k; int iv; int num_iterations; double rel_norm; /* Copy rhs to hypre_b vector. */ BeginTiming(public_xtra->time_index_copy_hypre); ForSubgridI(sg, GridSubgrids(grid)) { subgrid = SubgridArraySubgrid(GridSubgrids(grid), sg); rhs_sub = VectorSubvector(rhs, sg); rhs_ptr = SubvectorData(rhs_sub); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); nx_v = SubvectorNX(rhs_sub); ny_v = SubvectorNY(rhs_sub); nz_v = SubvectorNZ(rhs_sub); iv = SubvectorEltIndex(rhs_sub, ix, iy, iz); BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz, iv, nx_v, ny_v, nz_v, 1, 1, 1, { index[0] = i; index[1] = j; index[2] = k; HYPRE_StructVectorSetValues(hypre_b, index, rhs_ptr[iv]); });
void PermeabilityFace( Vector *zperm, Vector *permeability) { PFModule *this_module = ThisPFModule; InstanceXtra *instance_xtra = (InstanceXtra *)PFModuleInstanceXtra(this_module); PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module); Grid *z_grid = (instance_xtra -> z_grid); VectorUpdateCommHandle *handle; SubgridArray *subgrids; Subgrid *subgrid; Subvector *subvector_pc, *subvector_pf; int ix, iy, iz; int nx, ny, nz; double dx, dy, dz; int nx_pc, ny_pc, nz_pc; int nx_pf, ny_pf, nz_pf; int pci, pfi; int sg, i, j, k; int flopest; double *pf, *pc_l, *pc_u; /*----------------------------------------------------------------------- * Begin timing *-----------------------------------------------------------------------*/ BeginTiming(public_xtra -> time_index); /*----------------------------------------------------------------------- * exchange boundary data for cell permeability values *-----------------------------------------------------------------------*/ handle = InitVectorUpdate(permeability, VectorUpdateAll); FinalizeVectorUpdate(handle); /*----------------------------------------------------------------------- * compute the z-face permeabilities for each subgrid *-----------------------------------------------------------------------*/ subgrids = GridSubgrids(z_grid); ForSubgridI(sg, subgrids) { subgrid = SubgridArraySubgrid(subgrids, sg); subvector_pc = VectorSubvector(permeability, sg); subvector_pf = VectorSubvector(zperm, sg); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); dx = SubgridDX(subgrid); dy = SubgridDY(subgrid); dz = SubgridDZ(subgrid); nx_pc = SubvectorNX(subvector_pc); ny_pc = SubvectorNY(subvector_pc); nz_pc = SubvectorNZ(subvector_pc); nx_pf = SubvectorNX(subvector_pf); ny_pf = SubvectorNY(subvector_pf); nz_pf = SubvectorNZ(subvector_pf); flopest = nx_pf * ny_pf * nz_pf; pc_l = SubvectorElt(subvector_pc, ix ,iy ,iz-1); pc_u = SubvectorElt(subvector_pc, ix ,iy ,iz ); pf = SubvectorElt(subvector_pf, ix ,iy ,iz); pci = 0; pfi = 0; BoxLoopI2(i,j,k, ix,iy,iz,nx,ny,nz, pci,nx_pc,ny_pc,nz_pc,1,1,1, pfi,nx_pf,ny_pf,nz_pf,1,1,1, { pf[pfi] = Mean( pc_l[pci], pc_u[pci] ); });
void BCInternal( Problem * problem, ProblemData *problem_data, Matrix * A, Vector * f, double time) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); PFModule *phase_density = ProblemPhaseDensity(problem); WellData *well_data = ProblemDataWellData(problem_data); WellDataPhysical *well_data_physical; WellDataValue *well_data_value; TimeCycleData *time_cycle_data; int num_conditions = (public_xtra->num_conditions); Type0 *dummy0; Grid *grid = VectorGrid(f); SubgridArray *internal_bc_subgrids; Subgrid *subgrid, *ibc_subgrid, *well_subgrid, *new_subgrid; Submatrix *A_sub; Subvector *f_sub; double *internal_bc_conditions, *mp; double Z; double dx, dy, dz; int ix, iy, iz; int nx, ny, nz; int rx, ry, rz; int process; int i, j, k, i_sft, j_sft, k_sft; int grid_index, ibc_sg, well, index; int cycle_number, interval_number; double dtmp, ptmp, head, phead; int stencil[7][3] = { { 0, 0, 0 }, { -1, 0, 0 }, { 1, 0, 0 }, { 0, -1, 0 }, { 0, 1, 0 }, { 0, 0, -1 }, { 0, 0, 1 } }; /***** Some constants for the routine *****/ /* Hard-coded assumption for constant density. */ PFModuleInvokeType(PhaseDensityInvoke, phase_density, (0, NULL, NULL, &ptmp, &dtmp, CALCFCN)); dtmp = ProblemGravity(problem) * dtmp; /*-------------------------------------------------------------------- * gridify the internal boundary locations (should be done elsewhere?) *--------------------------------------------------------------------*/ if (num_conditions > 0) { internal_bc_subgrids = NewSubgridArray(); internal_bc_conditions = ctalloc(double, num_conditions); for (i = 0; i < num_conditions; i++) { switch ((public_xtra->type[i])) { case 0: { dummy0 = (Type0*)(public_xtra->data[i]); ix = IndexSpaceX((dummy0->xlocation), 0); iy = IndexSpaceY((dummy0->ylocation), 0); iz = IndexSpaceZ((dummy0->zlocation), 0); nx = 1; ny = 1; nz = 1; rx = 0; ry = 0; rz = 0; process = amps_Rank(amps_CommWorld); new_subgrid = NewSubgrid(ix, iy, iz, nx, ny, nz, rx, ry, rz, process); AppendSubgrid(new_subgrid, internal_bc_subgrids); internal_bc_conditions[i] = (dummy0->value); break; } } } }
void TurningBandsRF( GeomSolid *geounit, GrGeomSolid *gr_geounit, Vector *field, RFCondData *cdata) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module); InstanceXtra *instance_xtra = (InstanceXtra *)PFModuleInstanceXtra(this_module); double lambdaX = (public_xtra -> lambdaX); double lambdaY = (public_xtra -> lambdaY); double lambdaZ = (public_xtra -> lambdaZ); double mean = (public_xtra -> mean); double sigma = (public_xtra -> sigma); int num_lines = (public_xtra -> num_lines); double rzeta = (public_xtra -> rzeta); double Kmax = (public_xtra -> Kmax); double dK = (public_xtra -> dK); int log_normal = (public_xtra -> log_normal); int strat_type = (public_xtra -> strat_type); double low_cutoff = (public_xtra -> low_cutoff); double high_cutoff= (public_xtra -> high_cutoff); double pi = acos(-1.0); Grid *grid = (instance_xtra -> grid); Subgrid *subgrid; Subvector *field_sub; double xlo, ylo, zlo, sh_zlo; double xhi, yhi, zhi, sh_zhi; int ix, iy, iz; int nx, ny, nz; int r; double dx, dy, dz; double phi, theta; double *theta_array, *phi_array; double unitx, unity, unitz; double **shear_arrays, *shear_array; double *shear_min, *shear_max; double zeta, dzeta; int izeta, nzeta; double *Z; int is, l, i, j, k; int index; int doing_TB; double x, y, z; double *fieldp; double sqrtnl; Statistics *stats; /*----------------------------------------------------------------------- * start turning bands algorithm *-----------------------------------------------------------------------*/ /* initialize random number generator */ SeedRand(public_xtra -> seed); /* malloc space for theta_array and phi_array */ theta_array = talloc(double, num_lines); phi_array = talloc(double, num_lines); /* compute line directions */ for (l = 0; l < num_lines; l++) { theta_array[l] = 2.0*pi*Rand(); phi_array[l] = acos(1.0 - 2.0*Rand()); } /*----------------------------------------------------------------------- * Determine by how much to shear the field: * If there is no GeomSolid representation of the geounit, then * we do regular turning bands (by setting the shear_arrays to * all zeros). *-----------------------------------------------------------------------*/ /* Do regular turning bands */ if ( (strat_type == 0) || (!geounit) ) { shear_arrays = ctalloc(double *, GridNumSubgrids(grid)); shear_min = ctalloc(double, GridNumSubgrids(grid)); shear_max = ctalloc(double, GridNumSubgrids(grid)); ForSubgridI(is, GridSubgrids(grid)) { subgrid = GridSubgrid(grid, is); shear_arrays[is] = ctalloc(double, (SubgridNX(subgrid)*SubgridNY(subgrid))); }