int main( ) {
float A[n][n] = {
{2.0, 3.0, 1.0, 5.0},
{6.0, 13.0, 5.0, 19.0},
{2.0, 19.0, 10.0, 23.0},
{4.0, 10.0, 11.0, 31.0}};
float L[n][n], U[n][n];
int i, j;
lu_decomposition(A, L, U);
for (i = 0; i < n; i++) {
printf("[ ");
for (j = 0; j < n; j++)
printf("%.2f ", L[i][j]);
printf("] [ ");
for (j = 0; j < n; j++)
printf("%.2f ", U[i][j]);
printf("]\n");
}
return 0;
}
void ImplicitSweeper<time>::setup(bool coarse)
{
pfasst::encap::EncapSweeper<time>::setup(coarse);
auto const nodes = this->quadrature->get_nodes();
auto const num_nodes = this->quadrature->get_num_nodes();
if (this->quadrature->left_is_node()) {
ML_CLOG(INFO, "Sweeper", "implicit sweeper shouldn't include left endpoint");
throw ValueError("implicit sweeper shouldn't include left endpoint");
}
for (size_t m = 0; m < num_nodes; m++) {
this->s_integrals.push_back(this->get_factory()->create(pfasst::encap::solution));
this->fs_impl.push_back(this->get_factory()->create(pfasst::encap::function));
}
Matrix<time> QT = this->quadrature->get_q_mat().transpose();
auto lu = lu_decomposition(QT);
auto L = get<0>(lu);
auto U = get<1>(lu);
this->q_tilde = U.transpose();
ML_CLOG(DEBUG, "Sweeper", "Q':" << endl << QT);
ML_CLOG(DEBUG, "Sweeper", "L:" << endl << L);
ML_CLOG(DEBUG, "Sweeper", "U:" << endl << U);
ML_CLOG(DEBUG, "Sweeper", "LU:" << endl << L * U);
ML_CLOG(DEBUG, "Sweeper", "q_tilde:" << endl << this->q_tilde);
}
// simultaneous linear equation
void solute_SLE_with_n_variables(double coefficient_matrix[N][N], double right_hand_vector[N], double solution_vector[N]){
double l_matrix[N][N] = {0};
double u_matrix[N][N] = {0};
double mid_solution_vector[N];
lu_decomposition(coefficient_matrix, l_matrix, u_matrix);
forward_substitution(l_matrix, right_hand_vector, mid_solution_vector);
backward_substitution(u_matrix, mid_solution_vector, solution_vector);
}
int main(){
char *filename = "data_F.dat";
int n_col=2;
int n_row = 884;
float *file_data = load_matrix(filename, n_row);
float *data = malloc(n_row*n_col*sizeof(float));
float *b = malloc(n_row*sizeof(float));
float *theta = malloc(n_row*sizeof(float));
make_data(file_data, data, b,theta, n_row);
float *data_traspose = traspose(data,n_row,n_col);
float *matrix = multiply(data_traspose,data, n_col,n_row,n_row,n_col);
float *new_b = multiply(data_traspose,b, n_col, n_row, n_row, 1);
float *U = malloc(n_col*n_col*sizeof(float));
float *L = malloc(n_col*n_col*sizeof(float));
lu_decomposition(matrix,new_b,U,L,n_col);
float a1,a2;
solve_upper_triangular(U,new_b,&a1,&a2);
print_in_file(a1,a2);
return 0;
}
static lu_pair<scalar> lu_decomposition(const Matrix<scalar>& A)
{
assert(A.rows() == A.cols());
auto n = A.rows();
Matrix<scalar> L = Matrix<scalar>::Zero(n, n);
Matrix<scalar> U = Matrix<scalar>::Zero(n, n);
if (A.rows() == 1) {
L(0, 0) = 1.0;
U(0, 0) = A(0,0);
} else {
// first row of U is first row of A
auto U12 = A.block(0, 1, 1, n-1);
// first column of L is first column of A / a11
auto L21 = A.block(1, 0, n-1, 1) / A(0, 0);
// remove first row and column and recurse
auto A22 = A.block(1, 1, n-1, n-1);
Matrix<scalar> tmp = A22 - L21 * U12;
auto LU22 = lu_decomposition(tmp);
L(0, 0) = 1.0;
U(0, 0) = A(0, 0);
L.block(1, 0, n-1, 1) = L21;
U.block(0, 1, 1, n-1) = U12;
L.block(1, 1, n-1, n-1) = get<0>(LU22);
U.block(1, 1, n-1, n-1) = get<1>(LU22);
}
return lu_pair<scalar>(L, U);
}
int
lu_solver( const matrix<T1,D1,A1>& A,
matrix<T2,D2,A2>& x,
const matrix<T3,D3,A3>& b )
{
typedef matrix<T1,D1,A1> matrix_type;
//typedef typename matrix_type::value_type value_type;
typedef typename matrix_type::size_type size_type;
assert( A.row() == A.col() );
assert( A.row() == b.row() );
assert( b.col() == 1 );
size_type const n = A.row();
matrix_type L, U;
// if lu decomposition failed, return
if ( lu_decomposition( A, L, U ) ) return 1;
matrix_type Y;
if( forward_substitution( L, Y, b ) ) return 1; // solve LY=b
if( backward_substitution( U, x, Y )) return 1; //solve Ux=Y
return 0;
}
myResult* simulate_implicit(Model_t *m, myResult *result, mySpecies *sp[], myParameter *param[], myCompartment *comp[], myReaction *re[], myRule *rule[], myEvent *event[], myInitialAssignment *initAssign[], myAlgebraicEquations *algEq, timeVariantAssignments *timeVarAssign, double sim_time, double dt, int print_interval, double *time, int order, int use_lazy_method, int print_amount, allocated_memory *mem){
unsigned int i, j;
int cycle;
int error;
int end_cycle = get_end_cycle(sim_time, dt);
double reverse_time;
double *value_time_p = result->values_time;
double *value_sp_p = result->values_sp;
double *value_param_p = result->values_param;
double *value_comp_p = result->values_comp;
double **coefficient_matrix = NULL;
double *constant_vector = NULL;
int *alg_pivot = NULL;
double reactants_numerator, products_numerator;
double min_value;
double *init_val;
/* for implicit */
double **jacobian;
int is_convergence = 0;
double *b;
double *pre_b;
int *p; /* for pivot selection */
boolean flag;
double delta = 1.0e-8;
double tolerance = 1.0e-4; /* error tolerance of neuton method */
unsigned int loop;
double *delta_value;
double k_next; /* speculated k value : k(t+1) */
double *k_t; /* k(t) */
/* num of SBase objects */
unsigned int num_of_species = Model_getNumSpecies(m);
unsigned int num_of_parameters = Model_getNumParameters(m);
unsigned int num_of_compartments = Model_getNumCompartments(m);
unsigned int num_of_reactions = Model_getNumReactions(m);
unsigned int num_of_rules = Model_getNumRules(m);
unsigned int num_of_events = Model_getNumEvents(m);
unsigned int num_of_initialAssignments = Model_getNumInitialAssignments(m);
/* num of variables whose quantity is not a constant */
unsigned int num_of_all_var_species = 0;
unsigned int num_of_all_var_parameters = 0;
unsigned int num_of_all_var_compartments = 0;
unsigned int num_of_all_var_species_reference = 0;
/* num of variables (which is NOT changed by assignment nor algebraic rule) */
unsigned int num_of_var_species = 0;
unsigned int num_of_var_parameters = 0;
unsigned int num_of_var_compartments = 0;
unsigned int num_of_var_species_reference = 0;
unsigned int sum_num_of_vars;
/* All variables (whose quantity is not a constant) */
mySpecies **all_var_sp; /* all variable species */
myParameter **all_var_param; /* all variable parameters */
myCompartment **all_var_comp; /* all variable compartments */
mySpeciesReference **all_var_spr; /* all varialbe SpeciesReferences */
/* variables (which is NOT changed by assignment nor algebraic rule) */
mySpecies **var_sp;
myParameter **var_param;
myCompartment **var_comp;
mySpeciesReference **var_spr;
set_seed();
check_num(num_of_species, num_of_parameters, num_of_compartments, num_of_reactions, &num_of_all_var_species, &num_of_all_var_parameters, &num_of_all_var_compartments, &num_of_all_var_species_reference, &num_of_var_species, &num_of_var_parameters, &num_of_var_compartments, &num_of_var_species_reference, sp, param, comp, re);
/* create objects */
all_var_sp = (mySpecies **)malloc(sizeof(mySpecies *) * num_of_all_var_species);
all_var_param = (myParameter **)malloc(sizeof(myParameter *) * num_of_all_var_parameters);
all_var_comp = (myCompartment **)malloc(sizeof(myCompartment *) * num_of_all_var_compartments);
all_var_spr = (mySpeciesReference **)malloc(sizeof(mySpeciesReference *) * num_of_all_var_species_reference);
var_sp = (mySpecies **)malloc(sizeof(mySpecies *) * num_of_var_species);
var_param = (myParameter **)malloc(sizeof(myParameter *) * num_of_var_parameters);
var_comp = (myCompartment **)malloc(sizeof(myCompartment *) * num_of_var_compartments);
var_spr = (mySpeciesReference **)malloc(sizeof(mySpeciesReference *) * num_of_var_species_reference);
/* mySpecies *all_var_sp[num_of_all_var_species]; */
/* myParameter *all_var_param[num_of_all_var_parameters]; */
/* myCompartment *all_var_comp[num_of_all_var_compartments]; */
/* mySpeciesReference *all_var_spr[num_of_all_var_species_reference]; */
/* mySpecies *var_sp[num_of_var_species]; */
/* myParameter *var_param[num_of_var_parameters]; */
/* myCompartment *var_comp[num_of_var_compartments]; */
/* mySpeciesReference *var_spr[num_of_var_species_reference]; */
create_calc_object_list(num_of_species, num_of_parameters, num_of_compartments, num_of_reactions, all_var_sp, all_var_param, all_var_comp, all_var_spr, var_sp, var_param, var_comp, var_spr, sp, param, comp, re);
sum_num_of_vars = num_of_var_species + num_of_var_parameters +
num_of_var_compartments + num_of_var_species_reference;
jacobian = (double**)malloc(sizeof(double*)*(sum_num_of_vars));
for(i=0; i<sum_num_of_vars; i++){
jacobian[i] = (double*)malloc(sizeof(double)*(sum_num_of_vars));
}
b = (double *)malloc(sizeof(double) * (sum_num_of_vars));
pre_b = (double *)malloc(sizeof(double) * (sum_num_of_vars));
p = (int *)malloc(sizeof(int) * (sum_num_of_vars));
delta_value = (double *)malloc(sizeof(double) * (sum_num_of_vars));
k_t = (double *)malloc(sizeof(double) * (sum_num_of_vars));
/*
double b[sum_num_of_vars];
double pre_b[sum_num_of_vars];
int p[sum_num_of_vars];
double delta_value[sum_num_of_vars];
double k_t[sum_num_of_vars];
*/
if(algEq != NULL){
coefficient_matrix = (double**)malloc(sizeof(double*)*(algEq->num_of_algebraic_variables));
for(i=0; i<algEq->num_of_algebraic_variables; i++){
coefficient_matrix[i] = (double*)malloc(sizeof(double)*(algEq->num_of_algebraic_variables));
}
constant_vector = (double*)malloc(sizeof(double)*(algEq->num_of_algebraic_variables));
alg_pivot = (int*)malloc(sizeof(int)*(algEq->num_of_algebraic_variables));
}
PRG_TRACE(("Simulation for [%s] Starts!\n", Model_getId(m)));
cycle = 0;
/* initialize delay_val */
initialize_delay_val(sp, num_of_species, param, num_of_parameters, comp, num_of_compartments, re, num_of_reactions, sim_time, dt, 0);
/* calc temp value by assignment */
for(i=0; i<num_of_all_var_species; i++){
if(all_var_sp[i]->depending_rule != NULL && all_var_sp[i]->depending_rule->is_assignment){
all_var_sp[i]->temp_value = calc(all_var_sp[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<num_of_all_var_parameters; i++){
if(all_var_param[i]->depending_rule != NULL && all_var_param[i]->depending_rule->is_assignment){
all_var_param[i]->temp_value = calc(all_var_param[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<num_of_all_var_compartments; i++){
if(all_var_comp[i]->depending_rule != NULL && all_var_comp[i]->depending_rule->is_assignment){
all_var_comp[i]->temp_value = calc(all_var_comp[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<num_of_all_var_species_reference; i++){
if(all_var_spr[i]->depending_rule != NULL && all_var_spr[i]->depending_rule->is_assignment){
all_var_spr[i]->temp_value = calc(all_var_spr[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
/* forwarding value */
forwarding_value(all_var_sp, num_of_all_var_species, all_var_param, num_of_all_var_parameters, all_var_comp, num_of_all_var_compartments, all_var_spr, num_of_all_var_species_reference);
/* initialize delay_val */
initialize_delay_val(sp, num_of_species, param, num_of_parameters, comp, num_of_compartments, re, num_of_reactions, sim_time, dt, 0);
/* calc InitialAssignment */
calc_initial_assignment(initAssign, num_of_initialAssignments, dt, cycle, &reverse_time);
/* initialize delay_val */
initialize_delay_val(sp, num_of_species, param, num_of_parameters, comp, num_of_compartments, re, num_of_reactions, sim_time, dt, 0);
/* rewriting for explicit delay */
for(i=0; i<num_of_initialAssignments; i++){
for(j=0; j<initAssign[i]->eq->math_length; j++){
if(initAssign[i]->eq->number[j] == time){
TRACE(("time is replaced with reverse time\n"));
initAssign[i]->eq->number[j] = &reverse_time;
}else if(initAssign[i]->eq->number[j] != NULL){
init_val = (double*)malloc(sizeof(double));
*init_val = *initAssign[i]->eq->number[j];
mem->memory[mem->num_of_allocated_memory++] = init_val;
initAssign[i]->eq->number[j] = init_val;
}
}
}
for(i=0; i<timeVarAssign->num_of_time_variant_assignments; i++){
for(j=0; j<timeVarAssign->eq[i]->math_length; j++){
if(timeVarAssign->eq[i]->number[j] == time){
TRACE(("time is replaced with reverse time\n"));
timeVarAssign->eq[i]->number[j] = &reverse_time;
}else if(timeVarAssign->eq[i]->number[j] != NULL){
init_val = (double*)malloc(sizeof(double));
*init_val = *timeVarAssign->eq[i]->number[j];
mem->memory[mem->num_of_allocated_memory++] = init_val;
timeVarAssign->eq[i]->number[j] = init_val;
}
}
}
/* initialize delay_val */
initialize_delay_val(sp, num_of_species, param, num_of_parameters, comp, num_of_compartments, re, num_of_reactions, sim_time, dt, 0);
/* calc temp value by assignment */
for(i=0; i<num_of_all_var_species; i++){
if(all_var_sp[i]->depending_rule != NULL && all_var_sp[i]->depending_rule->is_assignment){
all_var_sp[i]->temp_value = calc(all_var_sp[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<num_of_all_var_parameters; i++){
if(all_var_param[i]->depending_rule != NULL && all_var_param[i]->depending_rule->is_assignment){
all_var_param[i]->temp_value = calc(all_var_param[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<num_of_all_var_compartments; i++){
if(all_var_comp[i]->depending_rule != NULL && all_var_comp[i]->depending_rule->is_assignment){
all_var_comp[i]->temp_value = calc(all_var_comp[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<num_of_all_var_species_reference; i++){
if(all_var_spr[i]->depending_rule != NULL && all_var_spr[i]->depending_rule->is_assignment){
all_var_spr[i]->temp_value = calc(all_var_spr[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
/* forwarding value */
forwarding_value(all_var_sp, num_of_all_var_species, all_var_param, num_of_all_var_parameters, all_var_comp, num_of_all_var_compartments, all_var_spr, num_of_all_var_species_reference);
/* initialize delay_val */
initialize_delay_val(sp, num_of_species, param, num_of_parameters, comp, num_of_compartments, re, num_of_reactions, sim_time, dt, 0);
/* calc temp value algebraic by algebraic */
if(algEq != NULL){
if(algEq->num_of_algebraic_variables > 1){
/* initialize pivot */
for(i=0; i<algEq->num_of_algebraic_variables; i++){
alg_pivot[i] = i;
}
for(i=0; i<algEq->num_of_algebraic_variables; i++){
for(j=0; j<algEq->num_of_algebraic_variables; j++){
coefficient_matrix[i][j] = calc(algEq->coefficient_matrix[i][j], dt, cycle, &reverse_time, 0);
/* TRACE(("coefficient matrix[%d][%d] = %lf\n", i, j, coefficient_matrix[i][j])); */
}
}
for(i=0; i<algEq->num_of_algebraic_variables; i++){
constant_vector[i] = -calc(algEq->constant_vector[i], dt, cycle, &reverse_time, 0);
/* TRACE(("constant vector[%d] = %lf\n", i, constant_vector[i])); */
}
/* LU decompostion */
error = lu_decomposition(coefficient_matrix, alg_pivot, algEq->num_of_algebraic_variables);
if(error == 0){/* failure in LU decomposition */
return NULL;
}
/* forward substitution & backward substitution */
lu_solve(coefficient_matrix, alg_pivot, algEq->num_of_algebraic_variables, constant_vector);
/* for(i=0; i<algEq->num_of_algebraic_variables; i++){ */
/* TRACE(("ans[%d] = %lf\n", i, constant_vector[i])); */
/* } */
for(i=0; i<algEq->num_of_alg_target_sp; i++){
algEq->alg_target_species[i]->target_species->temp_value = constant_vector[algEq->alg_target_species[i]->order];
}
for(i=0; i<algEq->num_of_alg_target_param; i++){
algEq->alg_target_parameter[i]->target_parameter->temp_value = constant_vector[algEq->alg_target_parameter[i]->order];
}
for(i=0; i<algEq->num_of_alg_target_comp; i++){
/* new code */
for(j=0; j<algEq->alg_target_compartment[i]->target_compartment->num_of_including_species; j++){
if(algEq->alg_target_compartment[i]->target_compartment->including_species[j]->is_concentration){
algEq->alg_target_compartment[i]->target_compartment->including_species[j]->temp_value = algEq->alg_target_compartment[i]->target_compartment->including_species[j]->temp_value*algEq->alg_target_compartment[i]->target_compartment->temp_value/constant_vector[algEq->alg_target_compartment[i]->order];
}
}
/* new code end */
algEq->alg_target_compartment[i]->target_compartment->temp_value = constant_vector[algEq->alg_target_compartment[i]->order];
}
}else{
if(algEq->target_species != NULL){
algEq->target_species->temp_value = -calc(algEq->constant, dt, cycle, &reverse_time, 0)/calc(algEq->coefficient, dt, cycle, &reverse_time, 0);
}
if(algEq->target_parameter != NULL){
algEq->target_parameter->temp_value = -calc(algEq->constant, dt, cycle, &reverse_time, 0)/calc(algEq->coefficient, dt, cycle, &reverse_time, 0);
}
if(algEq->target_compartment != NULL){
/* new code */
for(i=0; i<algEq->target_compartment->num_of_including_species; i++){
if(algEq->target_compartment->including_species[i]->is_concentration){
algEq->target_compartment->including_species[i]->temp_value = algEq->target_compartment->including_species[i]->temp_value*algEq->target_compartment->temp_value/(-calc(algEq->constant, dt, cycle, &reverse_time, 0)/calc(algEq->coefficient, dt, cycle, &reverse_time, 0));
}
}
/* new code end */
algEq->target_compartment->temp_value = -calc(algEq->constant, dt, cycle, &reverse_time, 0)/calc(algEq->coefficient, dt, cycle, &reverse_time, 0);
}
}
/* forwarding value */
forwarding_value(all_var_sp, num_of_all_var_species, all_var_param, num_of_all_var_parameters, all_var_comp, num_of_all_var_compartments, all_var_spr, num_of_all_var_species_reference);
}
/* initialize delay_val */
initialize_delay_val(sp, num_of_species, param, num_of_parameters, comp, num_of_compartments, re, num_of_reactions, sim_time, dt, 1);
/* cycle start */
for(cycle=0; cycle<=end_cycle; cycle++){
/* calculate unreversible fast reaction */
for(i=0; i<num_of_reactions; i++){
if(re[i]->is_fast && !re[i]->is_reversible){
if(calc(re[i]->eq, dt, cycle, &reverse_time, 0) > 0){
min_value = DBL_MAX;
for(j=0; j<re[i]->num_of_reactants; j++){
if(min_value > re[i]->reactants[j]->mySp->value/calc(re[i]->reactants[j]->eq, dt, cycle, &reverse_time, 0)){
min_value = re[i]->reactants[j]->mySp->value/calc(re[i]->reactants[j]->eq, dt, cycle, &reverse_time, 0);
}
}
for(j=0; j<re[i]->num_of_products; j++){
if(!Species_getBoundaryCondition(re[i]->products[j]->mySp->origin)){
re[i]->products[j]->mySp->value += calc(re[i]->products[j]->eq, dt, cycle, &reverse_time, 0)*min_value;
re[i]->products[j]->mySp->temp_value = re[i]->products[j]->mySp->value;
}
}
for(j=0; j<re[i]->num_of_reactants; j++){
if(!Species_getBoundaryCondition(re[i]->reactants[j]->mySp->origin)){
re[i]->reactants[j]->mySp->value -= calc(re[i]->reactants[j]->eq, dt, cycle, &reverse_time, 0)*min_value;
re[i]->reactants[j]->mySp->temp_value = re[i]->reactants[j]->mySp->value;
}
}
}
}
}
/* calculate reversible fast reactioin */
for(i=0; i<num_of_reactions; i++){
if(re[i]->is_fast && re[i]->is_reversible){
if(!(Species_getBoundaryCondition(re[i]->products[0]->mySp->origin)
&& Species_getBoundaryCondition(re[i]->reactants[0]->mySp->origin))){
products_numerator = calc(re[i]->products_equili_numerator, dt, cycle, &reverse_time, 0);
reactants_numerator = calc(re[i]->reactants_equili_numerator, dt, cycle, &reverse_time, 0);
if(products_numerator > 0 || reactants_numerator > 0){
if(Species_getBoundaryCondition(re[i]->products[0]->mySp->origin)){
re[i]->reactants[0]->mySp->value = (reactants_numerator/products_numerator)*re[i]->products[0]->mySp->value;
re[i]->reactants[0]->mySp->temp_value = re[i]->reactants[0]->mySp->value;
}else if(Species_getBoundaryCondition(re[i]->reactants[0]->mySp->origin)){
re[i]->products[0]->mySp->value = (products_numerator/reactants_numerator)*re[i]->reactants[0]->mySp->value;
re[i]->products[0]->mySp->temp_value = re[i]->products[0]->mySp->value;
}else{
re[i]->products[0]->mySp->value = (products_numerator/(products_numerator+reactants_numerator))*(re[i]->products[0]->mySp->temp_value+re[i]->reactants[0]->mySp->temp_value);
re[i]->reactants[0]->mySp->value = (reactants_numerator/(products_numerator+reactants_numerator))*(re[i]->products[0]->mySp->temp_value+re[i]->reactants[0]->mySp->temp_value);
re[i]->products[0]->mySp->temp_value = re[i]->products[0]->mySp->value;
re[i]->reactants[0]->mySp->temp_value = re[i]->reactants[0]->mySp->value;
}
}
}
}
}
/* event */
calc_event(event, num_of_events, dt, *time, cycle, &reverse_time);
/* substitute delay val */
substitute_delay_val(sp, num_of_species, param, num_of_parameters, comp, num_of_compartments, re, num_of_reactions, cycle);
/* progress */
if(cycle%(int)(end_cycle/10) == 0){
PRG_TRACE(("%3d %%\n", (int)(100*((double)cycle/(double)end_cycle))));
PRG_TRACE(("\x1b[1A"));
PRG_TRACE(("\x1b[5D"));
}
/* print result */
if(cycle%print_interval == 0){
/* Time */
*value_time_p = *time;
value_time_p++;
/* Species */
for(i=0; i<num_of_species; i++){
/* if(!(Species_getConstant(sp[i]->origin) && Species_getBoundaryCondition(sp[i]->origin))){ // XXX must remove this */
if(print_amount){
if(sp[i]->is_concentration){
*value_sp_p = sp[i]->value*sp[i]->locating_compartment->value;
}else{
*value_sp_p = sp[i]->value;
}
}else{
if(sp[i]->is_amount){
*value_sp_p = sp[i]->value/sp[i]->locating_compartment->value;
}else{
*value_sp_p = sp[i]->value;
}
}
value_sp_p++;
/* } */
}
/* Parameter */
for(i=0; i<num_of_parameters; i++){
/* if(!Parameter_getConstant(param[i]->origin)){ // XXX must remove this */
*value_param_p = param[i]->value;
/* } */
value_param_p++;
}
/* Compartment */
for(i=0; i<num_of_compartments; i++){
/* if(!Compartment_getConstant(comp[i]->origin)){ // XXX must remove this */
*value_comp_p = comp[i]->value;
/* } */
value_comp_p++;
}
}
/* time increase */
*time = (cycle+1)*dt;
/* implicit method */
/* define init value by Euler start */
calc_k(all_var_sp, num_of_all_var_species, all_var_param, num_of_all_var_parameters, all_var_comp, num_of_all_var_compartments, all_var_spr, num_of_all_var_species_reference, re, num_of_reactions, rule, num_of_rules, cycle, dt, &reverse_time, 0, 1);
/* preserve k(t) value */
for(i=0; i<sum_num_of_vars; i++){
if(i < num_of_var_species){
k_t[i] = var_sp[i]->k[0];
}else if(i < num_of_var_species+num_of_var_parameters){
k_t[i] = var_param[i-num_of_var_species]->k[0];
}else if(i < num_of_var_species+num_of_var_parameters+num_of_var_compartments){
k_t[i] = var_comp[i-num_of_var_species-num_of_var_parameters]->k[0];
}else{
k_t[i] = var_spr[i-num_of_var_species-num_of_var_parameters-num_of_var_compartments]->k[0];
}
}
calc_temp_value(all_var_sp, num_of_all_var_species, all_var_param, num_of_all_var_parameters, all_var_comp, num_of_all_var_compartments, all_var_spr, num_of_all_var_species_reference, dt, 0);
/* define init value by Euler end */
/* newton method */
if(use_lazy_method){
is_convergence = 0;
for(i=0; i<sum_num_of_vars; i++){
pre_b[i] = 0;
}
}
flag = 1;
while(flag){
/* calc b */
calc_k(var_sp, num_of_var_species, var_param, num_of_var_parameters, var_comp, num_of_var_compartments, var_spr, num_of_var_species_reference, re, num_of_reactions, rule, num_of_rules, cycle, dt, &reverse_time, 0, 0);
for(i=0; i<num_of_var_species; i++){
k_next = var_sp[i]->k[0];
b[i] = calc_implicit_formula(order, var_sp[i]->temp_value, var_sp[i]->value, var_sp[i]->prev_val[0], var_sp[i]->prev_val[1], var_sp[i]->prev_val[2], k_next, k_t[i], var_sp[i]->prev_k[0], var_sp[i]->prev_k[1], dt);
}
for(i=0; i<num_of_var_parameters; i++){
b[num_of_var_species+i] = calc_implicit_formula(order, var_param[i]->temp_value, var_param[i]->value, var_param[i]->prev_val[0], var_param[i]->prev_val[1], var_param[i]->prev_val[2], var_param[i]->k[0], k_t[num_of_var_species+i], var_param[i]->prev_k[0], var_param[i]->prev_k[1], dt);
}
for(i=0; i<num_of_var_compartments; i++){
b[num_of_var_species+num_of_var_parameters+i] = calc_implicit_formula(order, var_comp[i]->temp_value, var_comp[i]->value, var_comp[i]->prev_val[0], var_comp[i]->prev_val[1], var_comp[i]->prev_val[2], var_comp[i]->k[0], k_t[num_of_var_species+num_of_var_parameters+i], var_comp[i]->prev_k[0], var_comp[i]->prev_k[1], dt);
}
for(i=0; i<num_of_var_species_reference; i++){
b[num_of_var_species+num_of_var_parameters+num_of_var_compartments+i] = calc_implicit_formula(order, var_spr[i]->temp_value, var_spr[i]->value, var_spr[i]->prev_val[0], var_spr[i]->prev_val[1], var_spr[i]->prev_val[2], var_spr[i]->k[0], k_t[num_of_var_species+num_of_var_parameters+num_of_var_compartments+i], var_spr[i]->prev_k[0], var_spr[i]->prev_k[1], dt);
}
if(!use_lazy_method || !is_convergence){
/* calc jacobian by numerical differentiation */
for(loop=0; loop<sum_num_of_vars; loop++){
if(loop < num_of_var_species){
var_sp[loop]->temp_value += delta;
}else if(loop < num_of_var_species+num_of_var_parameters){
var_param[loop-num_of_var_species]->temp_value += delta;
}else if(loop < num_of_var_species+num_of_var_parameters+num_of_var_compartments){
var_comp[loop-num_of_var_species-num_of_var_parameters]->temp_value += delta;
}else{
var_spr[loop-num_of_var_species-num_of_var_parameters-num_of_var_compartments]->temp_value += delta;
}
calc_k(var_sp, num_of_var_species, var_param, num_of_var_parameters, var_comp, num_of_var_compartments, var_spr, num_of_var_species_reference, re, num_of_reactions, rule, num_of_rules, cycle, dt, &reverse_time, 0, 0);
for(i=0; i<num_of_var_species; i++){
k_next = var_sp[i]->k[0];
delta_value[i] = calc_implicit_formula(order, var_sp[i]->temp_value, var_sp[i]->value, var_sp[i]->prev_val[0], var_sp[i]->prev_val[1], var_sp[i]->prev_val[2], k_next, k_t[i], var_sp[i]->prev_k[0], var_sp[i]->prev_k[1], dt);
/* numerical differentiation */
jacobian[i][loop] = (delta_value[i]-b[i])/delta;
}
for(i=0; i<num_of_var_parameters; i++){
delta_value[num_of_var_species+i] = calc_implicit_formula(order, var_param[i]->temp_value, var_param[i]->value, var_param[i]->prev_val[0], var_param[i]->prev_val[1], var_param[i]->prev_val[2], var_param[i]->k[0], k_t[num_of_var_species+i], var_param[i]->prev_k[0], var_param[i]->prev_k[1], dt);
/* numerical differentiation */
jacobian[num_of_var_species+i][loop] = (delta_value[num_of_var_species+i]-b[num_of_var_species+i])/delta;
}
for(i=0; i<num_of_var_compartments; i++){
delta_value[num_of_var_species+num_of_var_parameters+i] = calc_implicit_formula(order, var_comp[i]->temp_value, var_comp[i]->value, var_comp[i]->prev_val[0], var_comp[i]->prev_val[1], var_comp[i]->prev_val[2], var_comp[i]->k[0], k_t[num_of_var_species+num_of_var_parameters+i], var_comp[i]->prev_k[0], var_comp[i]->prev_k[1], dt);
/* numerical differentiation */
jacobian[num_of_var_species+num_of_var_parameters+i][loop] = (delta_value[num_of_var_species+num_of_var_parameters+i]-b[num_of_var_species+num_of_var_parameters+i])/delta;
}
for(i=0; i<num_of_var_species_reference; i++){
delta_value[num_of_var_species+num_of_var_parameters+num_of_var_compartments+i] = calc_implicit_formula(order, var_spr[i]->temp_value, var_spr[i]->value, var_spr[i]->prev_val[0], var_spr[i]->prev_val[1], var_spr[i]->prev_val[2], var_spr[i]->k[0], k_t[num_of_var_species+num_of_var_parameters+num_of_var_compartments+i], var_spr[i]->prev_k[0], var_spr[i]->prev_k[1], dt);
/* numerical differentiation */
jacobian[num_of_var_species+num_of_var_parameters+num_of_var_compartments+i][loop] = (delta_value[num_of_var_species+num_of_var_parameters+num_of_var_compartments+i]-b[num_of_var_species+num_of_var_parameters+num_of_var_compartments+i])/delta;
}
if(loop < num_of_var_species){
var_sp[loop]->temp_value -= delta;
}else if(loop < num_of_var_species+num_of_var_parameters){
var_param[loop-num_of_var_species]->temp_value -= delta;
}else if(loop < num_of_var_species+num_of_var_parameters+num_of_var_compartments){
var_comp[loop-num_of_var_species-num_of_var_parameters]->temp_value -= delta;
}else{
var_spr[loop-num_of_var_species-num_of_var_parameters-num_of_var_compartments]->temp_value -= delta;
}
}
}
/* initialize p */
for(i=0; i<sum_num_of_vars; i++){
p[i] = i;
}
/* LU decomposition */
error = lu_decomposition(jacobian, p, sum_num_of_vars);
if(error == 0){/* failure in LU decomposition */
return NULL;
}
/* forward substitution & backward substitution */
lu_solve(jacobian, p, sum_num_of_vars, b);
/* calculate next temp value */
for(i=0; i<sum_num_of_vars; i++){
if(i < num_of_var_species){
var_sp[i]->temp_value -= b[i];
}else if(i < num_of_var_species+num_of_var_parameters){
var_param[i-num_of_var_species]->temp_value -= b[i];
}else if(i < num_of_var_species+num_of_var_parameters+num_of_var_compartments){
var_comp[i-num_of_var_species-num_of_var_parameters]->temp_value -= b[i];
}else{
var_spr[i-num_of_var_species-num_of_var_parameters-num_of_var_compartments]->temp_value -= b[i];
}
}
/* convergence judgement */
if(use_lazy_method){
is_convergence = 1;
for(i=0; i<sum_num_of_vars; i++){
if(fabs(b[i]) > fabs(pre_b[i])){
is_convergence = 0;
}
}
for(i=0; i<sum_num_of_vars; i++){
pre_b[i] = b[i];
}
}
/* error judgement */
flag = 0;
for(i=0; i<sum_num_of_vars; i++){
if(fabs(b[i]) > tolerance){
flag = 1;
}
}
}
/* calc temp value by assignment */
for(i=0; i<num_of_all_var_species; i++){
if(all_var_sp[i]->depending_rule != NULL && all_var_sp[i]->depending_rule->is_assignment){
all_var_sp[i]->temp_value = calc(all_var_sp[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<num_of_all_var_parameters; i++){
if(all_var_param[i]->depending_rule != NULL && all_var_param[i]->depending_rule->is_assignment){
all_var_param[i]->temp_value = calc(all_var_param[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<num_of_all_var_compartments; i++){
if(all_var_comp[i]->depending_rule != NULL && all_var_comp[i]->depending_rule->is_assignment){
all_var_comp[i]->temp_value = calc(all_var_comp[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<num_of_all_var_species_reference; i++){
if(all_var_spr[i]->depending_rule != NULL && all_var_spr[i]->depending_rule->is_assignment){
all_var_spr[i]->temp_value = calc(all_var_spr[i]->depending_rule->eq, dt, cycle, &reverse_time, 0);
}
}
/* calc temp value algebraic by algebraic */
if(algEq != NULL){
if(algEq->num_of_algebraic_variables > 1){
/* initialize pivot */
for(i=0; i<algEq->num_of_algebraic_variables; i++){
alg_pivot[i] = i;
}
for(i=0; i<algEq->num_of_algebraic_variables; i++){
for(j=0; j<algEq->num_of_algebraic_variables; j++){
coefficient_matrix[i][j] = calc(algEq->coefficient_matrix[i][j], dt, cycle, &reverse_time, 0);
}
}
for(i=0; i<algEq->num_of_algebraic_variables; i++){
constant_vector[i] = -calc(algEq->constant_vector[i], dt, cycle, &reverse_time, 0);
}
/* LU decompostion */
error = lu_decomposition(coefficient_matrix, alg_pivot, algEq->num_of_algebraic_variables);
if(error == 0){/* failure in LU decomposition */
return NULL;
}
/* forward substitution & backward substitution */
lu_solve(coefficient_matrix, alg_pivot, algEq->num_of_algebraic_variables, constant_vector);
for(i=0; i<algEq->num_of_alg_target_sp; i++){
algEq->alg_target_species[i]->target_species->temp_value = constant_vector[algEq->alg_target_species[i]->order];
}
for(i=0; i<algEq->num_of_alg_target_param; i++){
algEq->alg_target_parameter[i]->target_parameter->temp_value = constant_vector[algEq->alg_target_parameter[i]->order];
}
for(i=0; i<algEq->num_of_alg_target_comp; i++){
/* new code */
for(j=0; j<algEq->alg_target_compartment[i]->target_compartment->num_of_including_species; j++){
if(algEq->alg_target_compartment[i]->target_compartment->including_species[j]->is_concentration){
algEq->alg_target_compartment[i]->target_compartment->including_species[j]->temp_value = algEq->alg_target_compartment[i]->target_compartment->including_species[j]->temp_value*algEq->alg_target_compartment[i]->target_compartment->temp_value/constant_vector[algEq->alg_target_compartment[i]->order];
}
}
/* new code end */
algEq->alg_target_compartment[i]->target_compartment->temp_value = constant_vector[algEq->alg_target_compartment[i]->order];
}
}else{
if(algEq->target_species != NULL){
algEq->target_species->temp_value = -calc(algEq->constant, dt, cycle, &reverse_time, 0)/calc(algEq->coefficient, dt, cycle, &reverse_time, 0);
}
if(algEq->target_parameter != NULL){
algEq->target_parameter->temp_value = -calc(algEq->constant, dt, cycle, &reverse_time, 0)/calc(algEq->coefficient, dt, cycle, &reverse_time, 0);
}
if(algEq->target_compartment != NULL){
/* new code */
for(i=0; i<algEq->target_compartment->num_of_including_species; i++){
if(algEq->target_compartment->including_species[i]->is_concentration){
algEq->target_compartment->including_species[i]->temp_value = algEq->target_compartment->including_species[i]->temp_value*algEq->target_compartment->temp_value/(-calc(algEq->constant, dt, cycle, &reverse_time, 0)/calc(algEq->coefficient, dt, cycle, &reverse_time, 0));
}
}
/* new code end */
algEq->target_compartment->temp_value = -calc(algEq->constant, dt, cycle, &reverse_time, 0)/calc(algEq->coefficient, dt, cycle, &reverse_time, 0);
}
}
}
/* preserve prev_value and prev_k for multistep solution */
for(i=0; i<num_of_var_species; i++){
var_sp[i]->prev_val[2] = var_sp[i]->prev_val[1];
var_sp[i]->prev_val[1] = var_sp[i]->prev_val[0];
var_sp[i]->prev_val[0] = var_sp[i]->value;
var_sp[i]->prev_k[2] = var_sp[i]->prev_k[1];
var_sp[i]->prev_k[1] = var_sp[i]->prev_k[0];
var_sp[i]->prev_k[0] = k_t[i];
}
for(i=0; i<num_of_var_parameters; i++){
var_param[i]->prev_val[2] = var_param[i]->prev_val[1];
var_param[i]->prev_val[1] = var_param[i]->prev_val[0];
var_param[i]->prev_val[0] = var_param[i]->value;
var_param[i]->prev_k[2] = var_param[i]->prev_k[1];
var_param[i]->prev_k[1] = var_param[i]->prev_k[0];
var_param[i]->prev_k[0] = k_t[num_of_var_species+i];
}
for(i=0; i<num_of_var_compartments; i++){
var_comp[i]->prev_val[2] = var_comp[i]->prev_val[1];
var_comp[i]->prev_val[1] = var_comp[i]->prev_val[0];
var_comp[i]->prev_val[0] = var_comp[i]->value;
var_comp[i]->prev_k[2] = var_comp[i]->prev_k[1];
var_comp[i]->prev_k[1] = var_comp[i]->prev_k[0];
var_comp[i]->prev_k[0] = k_t[num_of_var_species+num_of_var_parameters+i];
}
for(i=0; i<num_of_var_species_reference; i++){
var_spr[i]->prev_val[2] = var_spr[i]->prev_val[1];
var_spr[i]->prev_val[1] = var_spr[i]->prev_val[0];
var_spr[i]->prev_val[0] = var_spr[i]->value;
var_spr[i]->prev_k[2] = var_spr[i]->prev_k[1];
var_spr[i]->prev_k[1] = var_spr[i]->prev_k[0];
var_spr[i]->prev_k[0] = k_t[num_of_var_species+num_of_var_parameters+i];
}
/* forwarding value */
forwarding_value(all_var_sp, num_of_all_var_species, all_var_param, num_of_all_var_parameters, all_var_comp, num_of_all_var_compartments, all_var_spr, num_of_all_var_species_reference);
}
PRG_TRACE(("Simulation for [%s] Ends!\n", Model_getId(m)));
if(algEq != NULL){
for(i=0; i<algEq->num_of_algebraic_variables; i++){
free(coefficient_matrix[i]);
}
free(coefficient_matrix);
free(constant_vector);
free(alg_pivot);
}
for(i=0; i<sum_num_of_vars; i++){
free(jacobian[i]);
}
free(all_var_sp);
free(all_var_param);
free(all_var_comp);
free(all_var_spr);
free(var_sp);
free(var_param);
free(var_comp);
free(var_spr);
/* for implicit */
free(jacobian);
return result;
}
int main(int argc, char *argv[])
{
int n1; /* number of samples in input trace */
int n1w; /* number of samples in time window */
int N1w; /* number of time windows */
int n1ws; /* number of samples in window (wo taper)*/
int n1wf; /* number of samples in first window */
int n1wi; /* number of samples in intermed. window */
int n1taper; /* number of samples in taper */
int n2; /* number of input traces */
int n3; /* number of input sections */
int n2w; /* number of traces in window */
int N2w; /* number of spacial windows */
int n2wu; /* updated number of traces in window */
int nfft; /* transform length */
int nf; /* number of frequencies */
int lenf; /* number of traces for filter */
int i2w,i2,jr,itt; /* summation indexes */
int i1,i3,i1w,ifq,ir; /* summation indexes */
int ig,ifv; /* summation indexes */
bool verb; /* flag to get advisory messages */
int *ipvt; /* indices of pivot permutations */
float *info; /* index of last zero pivot */
float dt; /* sampling interval in secs */
float df; /* sample interval in Hz */
float fmin; /* minimum frequency to process in Hz */
float fmax; /* maximum frequency to process in Hz */
float taper; /* length of taper */
float twlen; /* time window length */
float **tracein; /* real trace */
float **traceout; /* real trace */
float *traceintw; /* real trace in time window - input */
float *traceinttw; /* real trace in time window - input */
float *traceotw; /* real trace in time window - output */
float *traceottw; /* real trace in time window - output */
float *rauto; /* real part of autocorrelation */
float *iauto; /* imaginary part of autocorretation */
float **cautom; /* complex autocorrelation matrix */
float *aav; /* advanced autocorrelation vector */
kiss_fft_cpx *cdata; /* complex transformed trace (window) */
kiss_fft_cpx **fdata; /* data - freq. domain */
kiss_fft_cpx **fdataw; /* data - freq. domain - in window */
kiss_fft_cpx *sfv; /* single frequency vector */
kiss_fft_cpx **ffv; /* filtered frequency vector */
kiss_fft_cpx *fv; /* frequency vector */
kiss_fft_cpx *sfvout; /* single frequency output vector */
kiss_fft_cpx *sfvcj; /* complex conjugate of sfv */
kiss_fft_cpx *acorr; /* autocorrelation output */
kiss_fft_cpx *filter; /* filter */
kiss_fftr_cfg forw, invs;
sf_file in, out;
sf_init(argc,argv);
in = sf_input("in");
out = sf_output("out");
if(!sf_getbool("verb",&verb)) verb=false;
/* flag to get advisory messages */
if(!sf_histint(in, "n1", &n1)) sf_error("No n1 in input"); if (verb) sf_warning("n1 = %i",n1);
if(!sf_histfloat(in, "d1", &dt)) sf_error("No d1 in input"); if (verb) sf_warning("dt= %f",dt);
if(!sf_histint(in,"n2",&n2)) sf_error("No n2 in input"); if (verb) sf_warning("n2= %f",n2);
if(!sf_histint(in,"n3",&n3)) n3=1; if (verb) sf_warning("n3= %f",n3);
if(!sf_getfloat("taper",&taper)) taper=.1;
/* length of taper */
if (taper==0.0) taper=.004;
if(!sf_getfloat("fmin",&fmin)) fmin=1.;
/* minimum frequency to process in Hz */
if (fmin==0.0) if (verb) sf_warning("using fmin=1 Hz");
if(!sf_getfloat("fmax",&fmax)) fmax=1./(2*dt);
/* maximum frequency to process in Hz */
if (fmax==0.0) if (verb) sf_warning("using fmax=1/(2*dt) Hz");
if (!sf_getfloat("twlen", &twlen)) twlen=(float)(n1-1)*dt;
/* time window length */
if (twlen<.3) {
twlen=.3; if (verb) sf_warning("twlen cannot be less than .3s, using .3s");
}
/* setting taper and spatial and temporal windows */
n1taper =roundf(taper/dt);
n1taper = (n1taper%2 ? n1taper+1 : n1taper);
N1w = roundf((n1-1)*dt/twlen);
if (N1w==1) taper=0.0;
n1ws = roundf(twlen/dt) + 1;
n1wf = n1ws + n1taper/2;
n1wi = n1ws + n1taper;
if (!sf_getint("n2w", &n2w)) n2w=10;
/* number of traces in window */
if (!n2w) {
n2w = 10;
if (verb) sf_warning("n2w cannot be zero, using 10 traces");
}
if (verb) sf_warning("n2w = %i",n2w);
n2wu = n2w;
if (!sf_getint("lenf", &lenf)) lenf=4;
/* number of traces for filter */
if (!lenf) if (verb) sf_warning("using lenf=4");
N2w = n2/n2w;
/* Computute FFT optimization number */
nfft = 2*kiss_fft_next_fast_size((n1wf+1)/2);
forw = kiss_fftr_alloc(nfft,0,NULL,NULL);
invs = kiss_fftr_alloc(nfft,1,NULL,NULL);
nf = nfft/2 + 1;
df = 1.0/(nfft*dt);
/* space allocation */
cdata = (kiss_fft_cpx*) sf_complexalloc(nfft);
traceintw =sf_floatalloc(nfft);
traceinttw=sf_floatalloc(nfft);
fdata =(kiss_fft_cpx**) sf_complexalloc2(nf,n2);
fdataw =(kiss_fft_cpx**) sf_complexalloc2(nf,2*n2w+2*lenf);
tracein = sf_floatalloc2(n1,n2);
traceout= sf_floatalloc2(n1,n2);
sfv = (kiss_fft_cpx*) sf_complexalloc(2*n2w+2*lenf);
sfvcj = (kiss_fft_cpx*) sf_complexalloc(2*n2w+2*lenf);
acorr= (kiss_fft_cpx*) sf_complexalloc(lenf+1);
rauto = sf_floatalloc(lenf+1);
iauto = sf_floatalloc(lenf+1);
cautom = sf_floatalloc2(2*lenf,2*lenf);
aav = sf_floatalloc(2*lenf);
filter = (kiss_fft_cpx*) sf_complexalloc(2*lenf+1);
ffv = (kiss_fft_cpx**) sf_complexalloc2(nf,2*n2w);
sfvout=(kiss_fft_cpx*) sf_complexalloc(2*n2w);
fv =(kiss_fft_cpx*) sf_complexalloc(nfft);
traceotw = sf_floatalloc(nfft);
traceottw= sf_floatalloc(nfft);
ipvt = sf_intalloc(4*n2w);
info = sf_floatalloc(4*n2w);
/* zero output file */
memset((void *) traceout[0], 0, n2*n1*sizeof(float));
for (i3=0;i3<n3;i3++)
{
/* load traces into the zero-offset array and close tmpfile */
sf_floatread(tracein[0],n1*n2,in);
/* If dt not set, issue advisory on frequency step df */
if (dt && verb) sf_warning("df=%f", 1.0/(nfft*dt));
if (verb) sf_warning("nf=%i, df=%f, nfft=%i, n1taper=%i", nf,df,nfft,n1taper);
/* loop over time windows */
for (i1w=0;i1w<N1w;i1w++) {
if (i1w>0 && i1w<N1w-1) n1w=n1wi;
else if (i1w==0)
if (N1w>1) n1w = n1wf;
else n1w = n1;
else
n1w = n1 - n1ws*i1w + n1taper/2;
if (verb) sf_warning("i1w=%i, N1w=%i, n1w=%i, twlen=%f", i1w,N1w,n1w,twlen);
/* zero fdata */
memset((void *) fdata[0], 0, nf*n2*sizeof(kiss_fft_cpx));
/* select data */
for (i2=0;i2<n2;i2++) {
if (i1w>0)
for (i1=0;i1<n1w;i1++)
traceintw[i1]=tracein[i2][i1 + i1w*n1ws - n1taper/2];
else
for (i1=0;i1<n1w;i1++)
traceintw[i1]=tracein[i2][i1];
memset((void *) (traceintw + n1w), 0, (nfft-n1w)*sizeof(float));
memset((void *) cdata, 0, nfft*sizeof(kiss_fft_cpx));
/* FFT from t to f */
for (i1=0;i1<nfft;i1++)
traceinttw[i1]=(i1%2 ? -traceintw[i1] : traceintw[i1]);
kiss_fftr(forw, traceinttw, cdata);
/* Store values */
for (ifq = 0; ifq < nf; ifq++) {
fdata[i2][ifq] = cdata[nf-1-ifq];
}
}
/* Loop over space windows */
for (i2w=0;i2w<N2w;i2w++){
/* to take care of a possible incomplete last window */
if (n2<i2w*n2w+2*n2w)
n2wu = n2 - i2w*n2w;
else
n2wu = n2w;
if (verb) {
sf_warning("i2w=%i, n2=%i, n2w=%i",
i2w,n2,n2w);
sf_warning("n2wu=%i, N2w=%i, lenf=%i",
n2wu,N2w,lenf);
}
/* zero fdataw */
for (i2=0;i2<n2w+2*lenf;i2++)
memset((void *) fdataw[i2], 0, nf*sizeof(kiss_fft_cpx));
/* select data */
for (i2=0;i2<n2wu+2*lenf;i2++)
for (ifq = 0; ifq < nf; ifq++) {
if (i2w>0 && i2w<N2w-1)
fdataw[i2][ifq] = fdata[i2 + i2w*n2w - lenf][ifq];
else if (i2w==0)
if (i2>=lenf && i2<n2w+lenf)
fdataw[i2][ifq] = fdata[i2 - lenf][ifq];
else if (i2<lenf)
fdataw[i2][ifq] = fdata[0][ifq];
else
if (N2w>1)
fdataw[i2][ifq] = fdata[i2 - lenf][ifq];
else
fdataw[i2][ifq] = fdata[n2-1][ifq];
else
if (i2<n2wu+lenf)
fdataw[i2][ifq] = fdata[i2 + i2w*n2w - lenf][ifq];
else
fdataw[i2][ifq] = fdata[n2-1][ifq];
}
/* loop over frequencies */
for (ifq=0;ifq<nf;ifq++) {
if ((float)ifq*df>=fmin && (float)ifq*df<=fmax) {
/* Loop over space window */
memset((void *) sfv, 0, (n2wu+2*lenf)*sizeof(kiss_fft_cpx));
memset((void *) sfvcj, 0, (n2wu+2*lenf)*sizeof(kiss_fft_cpx));
for (i2=0;i2<n2wu+2*lenf;i2++) {
sfv[i2]=fdataw[i2][ifq];
sfvcj[i2]=sf_conjf(fdataw[i2][ifq]);
}
memset((void *) acorr, 0, (lenf+1)*sizeof(kiss_fft_cpx));
/* complex autocorrelation */
cxcor(n2wu,0,sfv,n2wu,0,sfv,lenf+1,0,acorr);
/* zeroing files */
memset((void *) rauto, 0, (lenf+1)*sizeof(float));
memset((void *) iauto, 0, (lenf+1)*sizeof(float));
/* taking real and imaginary parts */
for (i2=0;i2<lenf+1;i2++) {
rauto[i2]=acorr[i2].r;
iauto[i2]=acorr[i2].i;
}
/* zeroing files */
memset((void *) aav, 0, 2*lenf*sizeof(float));
memset((void *) filter, 0, (2*lenf+1)*sizeof(kiss_fft_cpx));
for (ir=0;ir<2*lenf;ir++)
memset((void *) cautom[ir], 0, 2*lenf*sizeof(float));
/* matrix problem */
for (ir=0;ir<lenf;ir++)
for (jr=0;jr<lenf;jr++) {
if (ir>=jr) cautom[ir][jr]=acorr[ir-jr].r;
else cautom[ir][jr]=acorr[jr-ir].r;
}
for (ir=lenf;ir<2*lenf;ir++)
for (jr=0;jr<lenf;jr++) {
if (ir-lenf<jr) cautom[ir][jr]=-acorr[jr-ir+lenf].i;
else cautom[ir][jr]= acorr[ir-jr-lenf].i;
}
for (ir=lenf;ir<2*lenf;ir++)
for (jr=lenf;jr<2*lenf;jr++)
cautom[ir][jr]=cautom[ir-lenf][jr-lenf];
for (ir=0;ir<lenf;ir++)
for (jr=lenf;jr<2*lenf;jr++)
cautom[ir][jr]=-cautom[ir+lenf][jr-lenf];
for (ig=0;ig<2*lenf;ig++) {
if (ig<lenf) aav[ig]=acorr[ig+1].r;
else aav[ig]=acorr[ig-lenf+1].i;
}
lu_decomposition(2*lenf,cautom,ipvt,info);
backward_substitution(2*lenf,cautom,ipvt,aav);
/* construct filter */
for (ifv=0,ig=lenf-1;ifv<lenf;ifv++,ig--)
filter[ifv]=sf_conjf(cmplx(aav[ig]/2.,aav[ig+lenf]/2.));
for (ifv=lenf+1,ig=0;ifv<2*lenf+1;ifv++,ig++)
filter[ifv]=cmplx(aav[ig]/2.,aav[ig+lenf]/2.);
memset((void *) sfvout, 0, n2wu*sizeof(kiss_fft_cpx));
/* convolution of data with filter */
/* output is one sample ahead */
cconv(n2wu+2*lenf,-lenf,sfv,2*lenf+1,-lenf,filter,n2wu,0,sfvout);
/* store filtered values */
for (i2=0;i2<n2wu;i2++) ffv[i2][ifq]=sfvout[i2];
}
} /* end of frequencies loop */
/* loop along space windows */
for (i2=0;i2<n2wu;i2++) {
/* select data */
for (ifq=0,itt=nf-1;ifq<nf;ifq++,itt--)
fv[ifq] = ffv[i2][itt];
memset((void *) (fv+nf), 0, (nfft-nf)*sizeof(kiss_fft_cpx));
memset((void *) traceotw, 0, nfft*sizeof(float));
/* FFT back from f to t and scaling */
kiss_fftri(invs,fv,traceotw);
for (i1=0;i1<SF_MIN(n1,nfft);i1++)
traceotw[i1]/=nfft;
for (i1=0;i1<SF_MIN(n1,nfft);i1++)
traceottw[i1]=(i1%2 ? -traceotw[i1] : traceotw[i1]);
/*loop along time */
if (N1w>1) {
/* first portion of time window */
if (i1w>0)
for (i1=0;i1<n1taper;i1++)
traceout[i2w*n2w+i2][i1+i1w*n1ws-n1taper/2]+=
traceottw[i1]*((float)(i1)*dt/taper);
else
for (i1=0;i1<n1taper;i1++)
traceout[i2w*n2w+i2][i1]=traceottw[i1];
/* intermediate portion of time window */
if (i1w>0)
for (i1=n1taper;i1<n1w-n1taper;i1++)
traceout[i2w*n2w+i2][i1+i1w*n1ws-n1taper/2]=traceottw[i1];
else
for (i1=n1taper;i1<n1w-n1taper;i1++)
traceout[i2w*n2w+i2][i1]=traceottw[i1];
/* last portion of time window */
if (i1w>0 && i1w<N1w-1)
for (i1=n1w-n1taper;i1<n1w;i1++)
traceout[i2w*n2w+i2][i1+i1w*n1ws-n1taper/2]+=
traceottw[i1]*(1.-((float)(i1-n1w+n1taper))*dt/taper);
else if (i1w==N1w-1)
for (i1=n1w-n1taper;i1<n1w;i1++)
traceout[i2w*n2w+i2][i1+i1w*n1ws-n1taper/2]=traceottw[i1];
else
for (i1=n1w-n1taper;i1<n1w;i1++)
traceout[i2w*n2w+i2][i1]+=traceottw[i1]*(1.-((float)(i1-n1w+n1taper))*dt/taper);
}
else {
for (i1=0;i1<n1;i1++)
traceout[i2w*n2w+i2][i1]=traceottw[i1];
}
} /* end loop over space windows */
} /* end loop over space windows */
} /* end of time windows loop */
/* Write output data to file */
sf_floatwrite(traceout[0], n1*n2, out);
if(verb) sf_warning("I3=%d is done!\n",i3+1);
}
/* Free allocated memory */
free(traceintw);
free(traceinttw);
free(fdataw[0]);
free(fdataw);
free(sfv);
free(sfvcj);
free(acorr);
free(rauto);
free(iauto);
free(cautom[0]);
free(cautom);
free(aav);
free(filter);
free(sfvout);
free(fv);
free(traceotw);
free(traceottw);
free(ffv[0]);
free(ffv);
free(tracein[0]);
free(tracein);
free(traceout[0]);
free(traceout);
exit(0);
}
int main(){
double *a, *l, *u, *lu, *pa;
int *piv;
int size = N*N;
piv = (int *)malloc(sizeof(int)*N);
a = (double *)malloc(sizeof(int)*size);
u = (double *)malloc(sizeof(int)*size);
l = (double *)malloc(sizeof(int)*size);
lu = (double *)malloc(sizeof(int)*size);
pa = (double *)malloc(sizeof(int)*size);
for(int i=0;i<N;i++){
for(int j=0;j<N;j++){
IDX(a,N,i,j) = 1.0 / (double)(1 + i + j);
}
}
lu_decomposition(a,l,u,N,piv);
//construct_P
double *p;
p = (double *)calloc(size, sizeof(double));
for(int i=0; i<N; i++){
IDX(p,N,where_a(i,piv,N), i) = 1;
}
printf("\n");
//compute PA
for(int i=0; i<N;i++){
for(int j=0;j<N;j++){
IDX(pa,N,i,j) = 0;
for(int k=0;k<N;k++){
IDX(pa,N,i,j) += IDX(p,N,i,k) * IDX(a,N,k,j);
}
}
}
//compute L \times U
for(int i=0; i<N;i++){
for(int j=0;j<N;j++){
IDX(lu,N,i,j) = 0;
for(int k=0;k<N;k++){
IDX(lu,N,i,j) += IDX(l,N,i,k) * IDX(u,N,k,j);
}
}
}
printf("P=\n");
print_matrix(p,N);
printf("A=\n");
print_matrix(a,N);
printf("L=\n");
print_matrix(l,N);
printf("U=\n");
print_matrix(u,N);
printf("P time A = \n");
print_matrix(pa,N);
printf("L times U =\n");
print_matrix(lu, N);
return 0;
}
int lu_decomposition(double *a, double *l, double *u, int m, int *piv){
if(m==1){
IDX(l,m,0,0) = 1.0;
IDX(u,m,0,0) = IDX(a,m,0,0);
*piv=0;
return 0;
}
//partial_pivoting ;
double max_a = 0;
*piv=0;
for(int i=0;i<m;i++){
if(fabs(IDX(a,m,i,0)) > max_a){
max_a = fabs(IDX(a,m,i,0));
*piv = i;
}
}
for(int i=0;i<m;i++){
double tem;
tem = IDX(a,m,0,i);
IDX(a,m,0,i) = IDX(a,m,*piv,i);
IDX(a,m,*piv,i) = tem;
}
IDX(u,m,0,0) = IDX(a,m,0,0);
for(int i=1; i<m; i++) IDX(u,m,i,0) = 0.0;
for(int i=1; i<m; i++) IDX(u,m,0,i) = IDX(a,m,0,i);
IDX(l,m,0,0) = 1.0;
for(int i=1; i<m; i++) IDX(l,m,i,0) = IDX(a,m,i,0) / IDX(u,m,0,0);
int size = (m-1) * (m-1);
double *sub_a,*sub_l,*sub_u;
sub_a = (double *) malloc(sizeof(double)*size);
sub_l = (double *) malloc(sizeof(double)*size);
sub_u = (double *) malloc(sizeof(double)*size);
for(int i=1;i<m;i++) for(int j=1;j<m;j++)
IDX(sub_a,m-1,i-1,j-1) = IDX(a,m,i,j) - IDX(l,m,i,j) - IDX(u,m,0,j);
lu_decomposition(sub_a,sub_l,sub_u,m-1,piv+1);
for(int i=1;i<m;i++) for(int j=1;j<m;j++){
IDX(l,m,i,j) = IDX(sub_l,m-1,i-1,j-1);
IDX(u,m,i,j) = IDX(sub_u,m-1,i-1,j-1);
}
for(int i=1; i<m;i++){
if(piv[i] != 0){
double tem = IDX(l,m,i,0);
IDX(l,m,i,0) = IDX(l,m,i+piv[i],0);
IDX(l,m,i+piv[i],0) = tem;
}
}
free(sub_a);
free(sub_u);
free(sub_l);
return 0;
}
int main(){
int kadai;
// 課題番号指定
while(1){
printf("課題番号: ");
scanf("%d", &kadai);
if (kadai < 1 || kadai > 8 || kadai == 7){
printf("1~8!!\n");
} else {
break;
}
}
if (kadai == 1){
double coefficient_mat[N][N] = {{1, 0, 0}, {3, 1, 0}, {-2, 2, 1}};
double right_hand_vec[N] = {2, 3, -1};
double solution_vec[N];
printf("--------------- L行列 ---------------\n");
print_array(coefficient_mat);
printf("------------- 右辺ベクトル ------------\n");
print_vector(right_hand_vec);
forward_substitution(coefficient_mat, right_hand_vec, solution_vec);
printf("------------- 解ベクトル --------------\n");
print_vector(solution_vec);
}
else if (kadai == 2)
{
double coefficient_mat[N][N] = {{2, 1, -1}, {0, 3, 2}, {0, 0, -3}};
double right_hand_vec[N] = {2, -3, 9};
double solution_vec[N];
printf("--------------- U行列 ----------------\n");
print_array(coefficient_mat);
printf("------------- 右辺ベクトル -------------\n");
print_vector(right_hand_vec);
backward_substitution(coefficient_mat, right_hand_vec, solution_vec);
printf("-------------- 解ベクトル -------------\n");
print_vector(solution_vec);
}
else if (kadai == 3)
{
double coefficient_mat[N][N];
double l_matrix[N][N] = {{1, 0, 0}, {3, 1, 0}, {-2, 2, 1}};
double u_matrix[N][N] = {{2, 1, -1}, {0, 3, 2}, {0, 0, -3}};
mat_mlt(l_matrix, u_matrix, coefficient_mat);
printf("---------- 係数行列 ----------\n");
print_array(coefficient_mat);
}
else if (kadai == 4)
{
double coefficient_mat[N][N] = {{2, 1, -1}, {6, 6, -1}, {-4, 4, 3}};
double l_matrix[N][N] = {0};
double u_matrix[N][N] = {0};
lu_decomposition(coefficient_mat, l_matrix, u_matrix);
printf("---------- L行列 ----------\n");
print_array(l_matrix);
printf("---------- U行列 ----------\n");
print_array(u_matrix);
}
else if (kadai == 5)
{
double coefficient_mat[N][N] = {{2, 1, -1}, {6, 6, -1}, {-4, 4, 3}};
double right_hand_vec[N] = {2, 3, -1};
double solution_vec[N];
printf("---------- 係数行列 ----------\n");
print_array(coefficient_mat);
printf("---------- 右辺ベクトル ----------\n");
print_vector(right_hand_vec);
solute_SLE_with_n_variables(coefficient_mat, right_hand_vec, solution_vec);
printf("---------- 解ベクトル ----------\n");
print_vector(solution_vec);
}
else if (kadai == 6)
{
double h_coefficient_mat[N][N];
double right_hand_vec[N];
double solution_vec[N];
int i, j;
for (i = 0; i < N; i++){
for (j = 0; j < N; j++){
h_coefficient_mat[i][j] = pow(0.5, abs(i-j));
}
}
printf("--------------- 行列H ---------------\n");
print_array(h_coefficient_mat);
for (i = 0; i < N; i++){
right_hand_vec[i] = 3 - pow(2, i-N+1) - pow(2, -i);
}
printf("------------- 右辺ベクトル -------------\n");
print_vector(right_hand_vec);
solute_SLE_with_n_variables(h_coefficient_mat, right_hand_vec, solution_vec);
printf("---------- 解ベクトル ----------\n");
print_vector(solution_vec);
}
else if (kadai == 8)
{
double h_mat[N][N];
double h_reverse_mat[N][N] = {0};
double solution_mat[N][N];
int i, j;
for (i = 0; i < N; i++){
for (j = 0; j < N; j++){
h_mat[i][j] = pow(0.5, abs(i-j));
}
}
evaluate_reverse_matrix(h_mat, h_reverse_mat);
mat_mlt(h_mat, h_reverse_mat, solution_mat);
printf("--------------- 行列H ---------------\n");
print_array(h_mat);
printf("------------ 行列Hの逆行列 ------------\n");
print_array(h_reverse_mat);
printf("---------- 解行列 ----------\n");
print_array(solution_mat);
}
return 0;
}