Exemple #1
0
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);
}
Exemple #2
0
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;
}
Exemple #5
0
 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);
 }
Exemple #6
0
 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);
 }
Exemple #7
0
 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);
 }
Exemple #8
0
 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);
 }
Exemple #9
0
// overload to allow Region1D as rhs arg
//---------------------------------------------------------
DVec& lu_solve(DMat& LU, Region1D<DVec> R)
//---------------------------------------------------------
{
  DVec rhs(R);
  return lu_solve(LU,rhs);
}
Exemple #10
0
	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;
}
Exemple #12
0
 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);
 }
Exemple #13
0
 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);
 }
Exemple #14
0
 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);
 }
Exemple #15
0
 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);
 }