int matinv(double **A, double **Ainv, int n) { register int i, j; double *b, temp; /* Decompose matrix into L and U triangular matrices */ if (lu_decompose(A, n) == 0) return (0); /* Singular */ /* Invert matrix by solving n simultaneous equations n times */ b = N_NEW(n, double); for (i = 0; i < n; i++) { for (j = 0; j < n; j++) b[j] = 0.0; b[i] = 1.0; lu_solve(Ainv[i], b, n); /* Into a row of Ainv: fix later */ } free(b); /* Transpose matrix */ for (i = 0; i < n; i++) { for (j = 0; j < i; j++) { temp = Ainv[i][j]; Ainv[i][j] = Ainv[j][i]; Ainv[j][i] = temp; } } return (1); }
int main(int, char**) { typedef mtl::dense2D<double> Matrix; typedef mtl::dense_vector<double> Vector; Matrix A(4, 4), L(4, 4), U(4, 4), AA(4, 4); Vector v(4); double c=1.0; for (unsigned i= 0; i < 4; i++) for(unsigned j= 0; j < 4; j++) { U[i][j]= i <= j ? c * (i+j+2) : (0); L[i][j]= i > j ? c * (i+j+1) : (i == j ? (1) : (0)); } std::cout << "L is:\n" << L << "U is:\n" << U; A= L * U; std::cout << "A is:\n" << A; AA= adjoint(A); for (unsigned i= 0; i < 4; i++) v[i]= double(i); Vector b( A*v ), b2( adjoint(A)*v ); Matrix LU(A); lu(LU); std::cout << "LU decomposition of A is:\n" << LU; Matrix B( lu_f(A) ); std::cout << "LU decomposition of A (as function result) is:\n" << B; Vector v1( lu_solve_straight(A, b) ); std::cout << "v1 is " << v1 << "\n"; Vector v2( lu_solve(A, b) ); std::cout << "v2 is " << v2 << "\n"; mtl::dense_vector<unsigned> P; lu(A, P); std::cout << "LU with pivoting is \n" << with_format(A, 5, 2) << "Permutation is " << P << "\n"; Vector v3( lu_apply(A, P, b) ); std::cout << "v3 is " << v3 << "\n"; Vector v4(lu_adjoint_apply(A, P, b2)); std::cout << "v4 is " << v4 << "\n"; Vector v5(lu_adjoint_solve(AA, b)); std::cout << "v5 is " << v5 << "\n"; return 0; }
double MatrixInversion(double** a,const int n,const double diagonal_increment) { // return the determined of matrix 'a' double** lu; int i,j; double* col; int* ps; if(diagonal_increment!=0) for(int i=0;i<n;i++) a[i][i] += diagonal_increment; lu = new double*[n]; assert(lu!=NULL); for(i=0;i<n;i++) { lu[i] = new double[n]; assert(lu[i]!=NULL); } ps = new int[n]; assert(ps!=NULL); double det; if((det=lu_decompose(a,n,lu,ps))==0) std::cerr<<"Singular Matrix!"<<std::endl; for(i=0;i<n;i++) det *= lu[i][i]; col = new double[n]; assert(col!=NULL); for(i=0;i<n;i++) { for(j=0;j<n;j++) col[j]=0.0; col[i]=1.0; lu_solve(a[i],col,n,lu,ps); } for(i=0;i<n;i++) { for(j=0;j<n;j++) { double temp; temp=a[i][j]; a[i][j]=a[j][i]; a[j][i]=temp; } } for(i=0;i<n;i++) { delete[] lu[i]; lu[i]=NULL; } delete[] lu; lu=NULL; delete[] ps; ps=NULL; delete[] col; col=NULL; return det; }
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; }
DLLEXPORT lapack_int z_lu_solve(lapack_int n, lapack_int nrhs, lapack_complex_double a[], lapack_complex_double b[]) { return lu_solve(n, nrhs, a, b, LAPACK_zgetrf, LAPACK_zgetrs); }
DLLEXPORT lapack_int c_lu_solve(lapack_int n, lapack_int nrhs, lapack_complex_float a[], lapack_complex_float b[]) { return lu_solve(n, nrhs, a, b, LAPACK_cgetrf, LAPACK_cgetrs); }
DLLEXPORT lapack_int d_lu_solve(lapack_int n, lapack_int nrhs, double a[], double b[]) { return lu_solve(n, nrhs, a, b, LAPACK_dgetrf, LAPACK_dgetrs); }
DLLEXPORT lapack_int s_lu_solve(lapack_int n, lapack_int nrhs, float a[], float b[]) { return lu_solve(n, nrhs, a, b, LAPACK_sgetrf, LAPACK_sgetrs); }
// overload to allow Region1D as rhs arg //--------------------------------------------------------- DVec& lu_solve(DMat& LU, Region1D<DVec> R) //--------------------------------------------------------- { DVec rhs(R); return lu_solve(LU,rhs); }
Vector inline solve(const Matrix& A, const Vector& b, tag::dense) { vampir_trace<3034> tracer; return lu_solve(A, b); }
int zgesv_idrs( const size_t n, // A is a function which multiplies the matrix by the first argument // and returns the result in the second. The second argument must // be manually cleared. The third parameter is user data, passed in // through Adata. void (*A)(const std::complex<double>*, std::complex<double>*, void*), std::complex<double>* b, std::complex<double>* x, // Optional parameters void *Adata = NULL, size_t maxit = 0, // default is min(2*n,1000) const size_t s = 4, const double tol = 1e-8, bool x_initialized = false, // P is a precondition which simply solves P*x' = x, // where x i the first argument. The second parameter is user data, // which is passed in through Pdata. void (*P)(std::complex<double>*, void*) = NULL, void *Pdata = NULL, double angle = 0.7 ){ double normb = vecnorm(n, b); if(0 == normb){ for(size_t i = 0; i < n; ++i){ x[i] = 0; } return 0; } const double tolb = tol*normb; // compute tolerance // Set initial x if(!x_initialized){ for(size_t i = 0; i < n; ++i){ x[i] = 0; } } std::complex<double> *r = new std::complex<double>[n]; A(x,r,Adata); for(size_t i = 0; i < n; ++i){ r[i] = b[i]-r[i]; } double normr = vecnorm(n, r); // Now, r = b-A*x std::complex<double> *Q = new std::complex<double>[n*s]; { // set up shadow space for(size_t j = 0; j < s; ++j){ for(size_t i = 0; i < n; ++i){ Q[i+j*n] = (double)rand()/(double)RAND_MAX - 0.5; } } // Orthogonalize Q orth(n, s, Q); } std::complex<double> *G = new std::complex<double>[n*s]; std::complex<double> *U = new std::complex<double>[n*s]; std::complex<double> *M = new std::complex<double>[s*s]; std::complex<double> *Mcopy = new std::complex<double>[s*s]; size_t *pivots = new size_t[s]; for(size_t j = 0; j < s; ++j){ for(size_t i = 0; i < n; ++i){ G[i+j*n] = 0; U[i+j*n] = 0; } for(size_t i = 0; i < s; ++i){ if(i == j){ M[i+j*s] = 1; }else{ M[i+j*s] = 0; } } } std::complex<double> *f = new std::complex<double>[s]; std::complex<double> *c = new std::complex<double>[s]; std::complex<double> *v = new std::complex<double>[n]; std::complex<double> *t = new std::complex<double>[n]; size_t iter = 0; std::complex<double> om = 1; if(0 == maxit){ maxit = 2*n; if(1000 < maxit){ maxit = 1000; } } int ret = 0; while(normr > tolb && iter < maxit){ std::cout << "iter = " << iter << std::endl; // generate RHS for small system for(size_t j = 0; j < s; ++j){ std::complex<double> sum = 0; for(size_t i = 0; i < n; ++i){ sum += r[i] * std::conj(Q[i+j*n]); } f[j] = sum; } for(size_t k = 0; k < s; ++k){ // solve small systems of M(k:s,k:s)*c(k:s) = f(k:s) { // Copy over stuff for a destructive LU solve in Mcopy for(size_t j = k; j < s; ++j){ for(size_t i = k; i < s; ++i){ Mcopy[i+j*s] = M[i+j*s]; } c[j] = f[j]; } // Perform LU solve... lu(s-k, s-k, s, &Mcopy[k+k*s], pivots); lu_solve(s-k, s-k, s, &Mcopy[k+k*s], pivots, &c[k]); } // v = r - G(:,k:s)*c; for(size_t i = 0; i < n; ++i){ std::complex<double> sum = 0; for(size_t j = k; j < s; ++j){ sum += G[i+j*n]*c[j]; } v[i] = r[i] - sum; } if(NULL != P){ P(v, Pdata); } //U(:,k) = U(:,k:s)*c + om*v; for(size_t i = 0; i < n; ++i){ std::complex<double> sum = 0; for(size_t j = k; j < s; ++j){ sum += U[i+j*n]*c[j]; } U[i+k*n] = sum + om*v[i]; } //G(:,k) = A*U(:,k); A(&U[0+k*n], &G[0+k*n], Adata); // Bi-Orthogonalise the new basis vectors for(size_t j = 0; j < k; ++j){ std::complex<double> alpha = 0; for(size_t i = 0; i < n; ++i){ alpha += std::conj(Q[i+j*n])*G[i+k*n]; } alpha /= M[j+j*s]; for(size_t i = 0; i < n; ++i){ G[i+k*n] -= alpha*G[i+j*n]; } for(size_t i = 0; i < n; ++i){ U[i+k*n] -= alpha*U[i+j*n]; } } // New column of M = (Q'*G)' (first k-1 entries are zero) for(size_t j = k; j < s; ++j){ std::complex<double> sum = 0; for(size_t i = 0; i < n; ++i){ sum += G[i+k*n]*std::conj(Q[i+j*n]); } M[j+k*s] = sum; } // Make r orthogonal to p_i, i = 1..k std::complex<double> beta = f[k]/M[k+k*s]; for(size_t i = 0; i < n; ++i){ r[i] -= beta*G[i+k*n]; } for(size_t i = 0; i < n; ++i){ x[i] += beta*U[i+k*n]; } ++iter; normr = vecnorm(n, r); if(normr < tolb || iter == maxit){ break; } // New f = Q'*r (first k components are zero) for(size_t j = k+1; j < s; ++j){ f[j] -= beta*M[j+k*s]; } } // end k loop // If we break'd out of the inner loop, do so again if(normr < tolb){ break; } // Now we have sufficient vectors in G_j to compute residual in G_j+1 // Note: r is already perpendicular to Q so v = r for(size_t i = 0; i < n; ++i){ v[i] = r[i]; } if(NULL != P){ P(v, Pdata); } A(v, t, Adata); { // compute new omega double norms = vecnorm(n, r), normt = vecnorm(n, t); std::complex<double> ts = 0; for(size_t i = 0; i < n; ++i){ ts += std::conj(t[i])*r[i]; } double rho = std::abs(ts/(normt*norms)); om = ts/(normt*normt); if(rho < angle){ om *= angle/rho; } } for(size_t i = 0; i < n; ++i){ r[i] -= om*t[i]; } for(size_t i = 0; i < n; ++i){ x[i] += om*v[i]; } normr = vecnorm(n, r); ++iter; } delete [] r; delete [] G; delete [] U; delete [] M; delete [] Mcopy; delete [] f; delete [] c; delete [] v; delete [] t; return ret; }
DLLEXPORT MKL_INT z_lu_solve(MKL_INT n, MKL_INT nrhs, MKL_Complex16 a[], MKL_Complex16 b[]) { return lu_solve(n, nrhs, a, b, zgetrf, zgetrs); }
DLLEXPORT MKL_INT c_lu_solve(MKL_INT n, MKL_INT nrhs, MKL_Complex8 a[], MKL_Complex8 b[]) { return lu_solve(n, nrhs, a, b, cgetrf, cgetrs); }
DLLEXPORT MKL_INT d_lu_solve(MKL_INT n, MKL_INT nrhs, double a[], double b[]) { return lu_solve(n, nrhs, a, b, dgetrf, dgetrs); }
DLLEXPORT MKL_INT s_lu_solve(MKL_INT n, MKL_INT nrhs, float a[], float b[]) { return lu_solve(n, nrhs, a, b, sgetrf, sgetrs); }