static int Precond(realtype tn, N_Vector u, N_Vector fu,
booleantype jok, booleantype *jcurPtr, realtype gamma,
void *P_data, N_Vector vtemp1, N_Vector vtemp2,
N_Vector vtemp3)
{
realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco;
realtype **(*P)[MY], **(*Jbd)[MY];
long int *(*pivot)[MY], ier;
int jx, jy;
realtype *udata, **a, **j;
UserData data;
/* Make local copies of pointers in P_data, and of pointer to u's data */
data = (UserData) P_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
udata = NV_DATA_S(u);
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
dencopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (jy=0; jy < MY; jy++) {
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*exp(RCONST(0.2)*ydn);
cyup = verdco*exp(RCONST(0.2)*yup);
diag = -(cydn + cyup + TWO*hordco);
for (jx=0; jx < MX; jx++) {
c1 = IJKth(udata,1,jx,jy);
c2 = IJKth(udata,2,jx,jy);
j = Jbd[jx][jy];
a = P[jx][jy];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
dencopy(j, a, NUM_SPECIES);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
denscale(-gamma, P[jx][jy], NUM_SPECIES);
/* Add identity matrix and do LU decompositions on blocks in place. */
for (jx=0; jx < MX; jx++) {
for (jy=0; jy < MY; jy++) {
denaddI(P[jx][jy], NUM_SPECIES);
ier = gefa(P[jx][jy], NUM_SPECIES, pivot[jx][jy]);
if (ier != 0) return(1);
}
}
return(0);
}
static int Precond(realtype tn, N_Vector y, N_Vector fy, booleantype jok,
booleantype *jcurPtr, realtype gamma, void *P_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
realtype c1, c2, czdn, czup, diag, zdn, zup, q4coef, delz, verdco, hordco;
realtype **(*P)[MZ], **(*Jbd)[MZ];
long int *(*pivot)[MZ];
int ier, jx, jz;
realtype *ydata, **a, **j;
UserData data;
realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0;
/* Make local copies of pointers in P_data, and of pointer to y's data */
data = (UserData) P_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
ydata = NV_DATA_S(y);
/* Load problem coefficients and parameters */
Q1 = data->p[0];
Q2 = data->p[1];
C3 = data->p[2];
A3 = data->p[3];
A4 = data->p[4];
KH = data->p[5];
VEL = data->p[6];
KV0 = data->p[7];
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (jz=0; jz < MZ; jz++)
for (jx=0; jx < MX; jx++)
dencopy(Jbd[jx][jz], P[jx][jz], NUM_SPECIES);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
delz = data->dz;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (jz=0; jz < MZ; jz++) {
zdn = ZMIN + (jz - RCONST(0.5))*delz;
zup = zdn + delz;
czdn = verdco*EXP(RCONST(0.2)*zdn);
czup = verdco*EXP(RCONST(0.2)*zup);
diag = -(czdn + czup + RCONST(2.0)*hordco);
for (jx=0; jx < MX; jx++) {
c1 = IJKth(ydata,1,jx,jz);
c2 = IJKth(ydata,2,jx,jz);
j = Jbd[jx][jz];
a = P[jx][jz];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
dencopy(j, a, NUM_SPECIES);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (jz=0; jz < MZ; jz++)
for (jx=0; jx < MX; jx++)
denscale(-gamma, P[jx][jz], NUM_SPECIES);
/* Add identity matrix and do LU decompositions on blocks in place. */
for (jx=0; jx < MX; jx++) {
for (jz=0; jz < MZ; jz++) {
denaddI(P[jx][jz], NUM_SPECIES);
ier = gefa(P[jx][jz], NUM_SPECIES, pivot[jx][jz]);
if (ier != 0) return(1);
}
}
return(0);
}
integer DenseFactor(DenseMat A, integer *p)
{
return(gefa(A->data, A->size, p));
}
int React (realtype t, realtype stepsize, Chem_Data CD, int cell, int * NR_times){
if (CD->Vcele[cell].sat < 1.0E-2) return(0); // very dry, no reaction can take place.
int i, j ,k, control, speciation_flg = CD->SPCFlg, num_spe = CD->NumStc + CD->NumSsc, min_pos , pivot_flg;
int stc = CD->NumStc, ssc = CD->NumSsc, spc = CD->NumSpc, sdc = CD->NumSdc, nkr = CD->NumMkr + CD->NumAkr, smc = CD->NumMin;
double * residue, * residue_t, * tmpconc, * totconc, * area, * error, * gamma, * Keq, * Rate_pre, * IAP, * dependency, * Rate_spe, * Rate_spe_t, * Rate_spet;
residue = (double*) malloc ( stc * sizeof(double));
residue_t = (double*) malloc ( stc * sizeof(double));
tmpconc = (double*) malloc ( num_spe * sizeof(double));
totconc = (double*) malloc ( stc * sizeof(double));
area = (double*) malloc ( smc * sizeof(double));
error = (double*) malloc ( stc * sizeof(double));
gamma = (double*) malloc ( num_spe * sizeof(double));
Keq = (double*) malloc ( ssc * sizeof(double));
Rate_pre = (double*) malloc ( nkr * sizeof(double));
IAP = (double*) malloc ( nkr * sizeof(double));
dependency = (double*) malloc ( nkr * sizeof(double));
Rate_spe = (double*) malloc ( stc * sizeof(double));
Rate_spe_t = (double*) malloc ( stc * sizeof(double));
Rate_spet = (double*) malloc ( stc * sizeof(double));
long int * p = (long int*)malloc ( (CD->NumStc - CD->NumMin) * sizeof(long int));
realtype * x_= (realtype*)malloc ( (CD->NumStc - CD->NumMin) * sizeof(realtype));
double tmpval, tmpprb, inv_sat, I, Iroot, tmpKeq, ISupdateflg, adh, bdh, bdt, maxerror = 1, surf_ratio, tot_cec, tmpprb_inv;
realtype ** jcb;
control = 0;
tmpprb = 1.0E-2;
tmpprb_inv = 1.0 /tmpprb ;
inv_sat = 1.0 / CD->Vcele[cell].sat;
for (i = 0 ; i < CD->NumMin; i++){
area[i] = CD->Vcele[cell].p_para[i+CD->NumStc - CD->NumMin] * CD->Vcele[cell].p_conc[i+ CD->NumStc - CD->NumMin] * CD->chemtype[i + CD->NumStc - CD->NumMin].MolarMass;
}
if ( CD->SUFEFF){
if ( CD->Vcele[cell].sat < 1.0){
surf_ratio = pow(CD->Vcele[cell].sat, 0.6667);
for ( i = 0 ; i < CD->NumMin; i ++){
area[i] *= surf_ratio;
}
}
}// Lichtner's 2 third law if SUF_EFF is turned on.
for ( j = 0 ; j < CD->NumStc; j ++){
Rate_spe[j] = 0.0;
}
for (i = 0 ; i < CD->NumMkr + CD->NumAkr; i ++){
min_pos = CD->kinetics[i].position - CD->NumStc + CD->NumMin;
IAP[i] = 0.0;
for ( j = 0; j < CD->NumStc; j ++){
IAP[i] += log10(CD->Vcele[cell].p_actv[j])* CD->Dep_kinetic[min_pos][j];
}
IAP[i] = pow(10, IAP[i]);
tmpKeq = pow(10, CD->KeqKinect[min_pos]);
dependency[i] = 1.0;
for ( k = 0 ; k < CD->kinetics[i].num_dep; k ++)
dependency[i] *= pow(CD->Vcele[cell].p_actv[CD->kinetics[i].dep_position[k]], CD->kinetics[i].dep_power[k]);
/* Calculate the predicted rate depending on the type of rate law! */
Rate_pre[i] = area[min_pos]*(pow(10,CD->kinetics[i].rate))* dependency[i] *(1 - (IAP[i] / tmpKeq)) * 60;
/* Rate_pre: in mol/L water / min rate per reaction
area: m2/L water
rate: mol/m2/s
dependency: dimensionless;
*/
for ( j = 0 ; j < CD->NumStc; j ++){
Rate_spe[j] += Rate_pre[i]*CD->Dep_kinetic[min_pos][j];
}
}
for (i = 0 ; i < CD->NumMkr + CD->NumAkr; i++){
min_pos = CD->kinetics[i].position - CD->NumStc + CD->NumMin;
if ( Rate_pre[i] < 0.0){
if ( CD->Vcele[cell].p_conc[min_pos + CD->NumStc - CD->NumMin] < 1.0E-8) // mineral cutoff when mineral is disappearing.
area[min_pos] = 0.0;
}
}
for ( i = 0 ; i < CD->NumSpc; i ++)
if ( CD->chemtype[i].itype == 1)
Rate_spe[i] = Rate_spe[i]*inv_sat;
jcb = denalloc(CD->NumStc - CD->NumMin);
/*
long int p[CD->NumStc];
realtype x_[CD->NumStc];
control =0;
double maxerror= 1;
*/
if ( CD->TEMcpl == 0 ){
for ( i = 0 ; i < CD->NumSsc; i ++)
Keq[i] = CD->Keq[i];
adh = CD->DH.adh;
bdh = CD->DH.bdh;
bdt = CD->DH.bdt;
}
for ( i = 0; i < CD->NumStc; i ++){
tmpconc[i] = log10(CD->Vcele[cell].p_conc[i]);
}
for ( i = 0; i < CD->NumSsc; i ++){
tmpconc[i + CD->NumStc] = log10(CD->Vcele[cell].s_conc[i]);
}
tot_cec = 0.0;
for ( i = 0; i < num_spe; i ++){
if ( CD->chemtype[i].itype == 3){
tot_cec += pow (10, tmpconc[i]);
}
}
// if ( cell == 1) fprintf(stderr, " Tot_site is %f, while the tot_conc for site %s is %f, p_conc is %f\n", tot_cec, CD->chemtype[7].ChemName, CD->Vcele[cell].t_conc[7], CD->Vcele[cell].p_conc[7]);
I = 0;
for ( i = 0 ; i < num_spe; i ++){
I += 0.5 * pow( 10, tmpconc[i]) * sqr(CD->chemtype[i].Charge);
}
Iroot = sqrt(I);
for ( i = 0 ; i < num_spe; i ++){
switch ( CD->chemtype[i].itype){
case 1:
gamma[i] = ( - adh * sqr(CD->chemtype[i].Charge) * Iroot)/(1 + bdh * CD->chemtype[i].SizeF * Iroot) + bdt * I;
break;
case 2: gamma[i] = log10(CD->Vcele[cell].sat); break;
case 3: gamma[i] = - log10(tot_cec); break;
case 4: gamma[i] = - tmpconc[i]; break;
}
}
/*
for ( i = 0 ; i < num_spe; i ++){
if ( CD->chemtype[i].itype == 2)
{
if ( cell == 700) fprintf(stderr, "%s with %f\n", CD->chemtype[i].ChemName, gamma[i]);
}
}
*/
while (maxerror > TOL){
for ( i = 0; i < CD->NumSsc; i ++){
tmpval = 0.0;
for ( j = 0 ; j < CD->NumSdc; j ++){
tmpval += (tmpconc[j] + gamma[j])* CD->Dependency[i][j];
}
tmpval -= Keq[i] + gamma[i + CD->NumStc];
tmpconc[i+CD->NumStc] = tmpval;
// fprintf(stderr, " UPDATE %s %6.4f\n", CD->chemtype[i+CD->NumStc].ChemName, tmpconc[i+CD->NumStc]);
}
for ( j = 0 ; j < CD->NumStc; j ++){
Rate_spet[j] = 0.0;
}
for (i = 0 ; i < CD->NumMkr + CD->NumAkr; i ++){
min_pos = CD->kinetics[i].position - CD->NumStc + CD->NumMin;
// fprintf(stderr, " Min_pos %d\n", min_pos);
IAP[i] = 0.0;
// fprintf(stderr, " IAP_BC %s %6.4f\n", CD->kinetics[i].Label, IAP[i]);
for ( j = 0; j < CD->NumStc; j ++){
if ( CD->chemtype[j].itype !=4){
IAP[i] += (tmpconc[j]+gamma[j]) * CD->Dep_kinetic[min_pos][j];
// fprintf(stderr, " IAP_CALC, %s %6.4f\t %6.4f\n" ,CD->chemtype[j].ChemName, tmpconc[j]+gamma[j], CD->Dep_kinetic[min_pos][j]);
}
}
IAP[i] = pow(10, IAP[i]);
tmpKeq = pow(10, CD->KeqKinect[min_pos]);
/*
if ( IAP[i] < tmpKeq)
rct_drct[i] = 1.0;
if ( IAP[i] > tmpKeq)
rct_drct[i] = -1.0;
if ( IAP[i] == tmpKeq)
rct_drct[i] = 0.0;
*/
// fprintf(stderr, " IAP_BC %s %6.4f\n", CD->kinetics[i].Label, IAP[i]);
dependency[i] = 0.0;
for ( k = 0 ; k < CD->kinetics[i].num_dep; k ++)
dependency[i] += (tmpconc[CD->kinetics[i].dep_position[k]] + gamma[CD->kinetics[i].dep_position[k]])* CD->kinetics[i].dep_power[k];
dependency[i] = pow(10, dependency[i]);
// fprintf(stderr, " Dep: %6.4f\n", dependency[i]);
/* Calculate the predicted rate depending on the type of rate law! */
Rate_pre[i] = area[min_pos]*(pow(10,CD->kinetics[i].rate))* dependency[i] *(1 - (IAP[i] / tmpKeq)) * 60;
/* Rate_pre: in mol/L water / min
area: m2/L water
rate: mol/m2/s
dependency: dimensionless;
*/
// fprintf(stderr, " Reaction %s, Label %s, IAP %6.4f\t, Rate %2.1g\n",CD->kinetics[i].species, CD->kinetics[i].Label, IAP[i], Rate_pre[i]);
for ( j = 0 ; j < CD->NumStc; j ++){
Rate_spet[j] += Rate_pre[i]*CD->Dep_kinetic[min_pos][j];
//fprintf(stderr, " Rate for %s: %6.4g\n", CD->chemtype[j].ChemName, Rate_pre[i]*CD->Dep_kinetic[min_pos][j]);
}
// Adjust the unit of the calcuated rate. Note that for mineral, the unit of rate and the unit of concentration are mol/L porous media
// for the aqueous species, the unit of the rate and the unit of the concentration are mol/L pm and mol/L water respectively.
}
/*for ( i = 0 ; i < CD->NumSpc; i ++){
// fprintf(stderr, " Tot_rate for %s: %6.4g\n", CD->chemtype[i].ChemName, Rate_spet[i]);
Rate_spet[i] = Rate_spet[i]/(CD->Vcele[cell].porosity * CD->Vcele[cell].sat);
// fprintf(stderr, " Tot_rate for %s: %6.4g\n", CD->chemtype[i].ChemName, Rate_spet[i]);
}*/
for ( i = 0 ; i < CD->NumSpc; i ++)
if ( CD->chemtype[i].itype == 1)
Rate_spet[i] = Rate_spet[i]*inv_sat;
for ( i = 0; i < CD->NumStc - CD->NumMin; i ++){
tmpval = 0.0;
for ( j = 0; j < CD->NumStc + CD-> NumSsc; j++){
tmpval+= CD->Totalconc[i][j]*pow(10,tmpconc[j]);
//fprintf(stderr, " %s %6.4f\t %6.4f\n", CD->chemtype[j].ChemName,CD->Totalconc[i][j], tmpconc[j]);
}
totconc[i] = tmpval;
residue[i] = tmpval -( CD->Vcele[cell].t_conc[i] + (Rate_spe[i]+ Rate_spet[i])*stepsize *0.5);
//residue[i] = tmpval -( CD->Vcele[cell].t_conc[i] + (Rate_spet[i])*stepsize);
// fprintf(stderr, " %s Residue: %6.4g\t Sum1:%6.4g\tSum2:%6.4g\tRate1%6.4g\tRate2%6.4g\n", CD->chemtype[i].ChemName, residue[i],totconc[i], CD->Vcele[cell].t_conc[i], Rate_spe[i], Rate_spet[i]);
}
if ( control % SKIP_JACOB == 0) // update jacobian every the other iteration
{
for ( k = 0; k < CD->NumStc - CD->NumMin; k ++){
tmpconc[k] += tmpprb;
for ( i = 0; i < CD->NumSsc; i ++){
tmpval = 0.0;
for ( j = 0 ; j < CD->NumSdc; j ++)
tmpval += (tmpconc[j]+ gamma[j])* CD->Dependency[i][j];
tmpval -= Keq[i] + gamma[i + CD->NumStc];
tmpconc[i+CD->NumStc] = tmpval;
// fprintf(stderr, " CALC_SEC %s %6.4f\t %6.4f\n", CD->chemtype[i+CD->NumSpc].ChemName, tmpval, pow(10,tmpconc[i+CD->NumSpc]));
}
for ( i = 0; i < CD->NumStc - CD->NumMin; i ++){
tmpval = 0.0;
for ( j = 0; j < CD->NumStc + CD-> NumSsc; j++){
tmpval+= CD->Totalconc[i][j]*pow(10,tmpconc[j]);
// fprintf(stderr, " CALC_TOT %s %6.4f\t %6.4f\n",CD->chemtype[j].ChemName, CD->Totalconc[i][j], pow(10,tmpconc[j]));
}
// totconc[i] = tmpval;
//fprintf(stderr, " CALC_TOT Sum%s %6.4f\t %12.10f\n", CD->chemtype[i].ChemName, log10(totconc[i]), totconc[i]);
residue_t[i] = tmpval - (CD->Vcele[cell].t_conc[i] + (Rate_spe[i] + Rate_spet[i])*stepsize *0.5);
jcb[k][i] = (residue_t[i]- residue[i]) * tmpprb_inv;
// fprintf(stderr, "%g\n", jcb[k][i]);
// fprintf(stderr, " Sum%s %6.4f\t %6.4f\n", CD->chemtype[i].ChemName, tmpval, residue_t[i]);
}
tmpconc[k] -= tmpprb;
}
}
for ( i = 0 ; i < CD->NumStc - CD->NumMin; i ++)
x_[i] = - residue[i];
// fprintf(stderr, " Jacobian Matrix!\n");
// if (control == 1) denprint(jcb, CD->NumStc);
// fprintf(stderr, " LU %ld\n",gefa(jcb,CD->NumStc,p));
pivot_flg = gefa(jcb, CD->NumStc - CD->NumMin, p);
if (pivot_flg != 0){/*
for ( i = 0 ; i < CD->NumStc; i ++)
fprintf(stderr, "%d %s Conp: %6.4g\t, sat: %6.4g\t, height: %6.4g\t, tot_conc: %6.4g\n", cell , CD->chemtype[i].ChemName, CD->Vcele[cell].p_conc[i], CD->Vcele[cell].sat, CD->Vcele[cell].height_o, CD->Vcele[cell].t_conc[i]);*/
CD->Vcele[cell].illness ++;
// denprint(jcb, CD->NumStc);
return(1);
}
// assert(pivot_flg ==0);
gesl(jcb, CD->NumStc - CD->NumMin, p, x_);
// gauss(jcb, x_, CD->NumStc);
for (i = 0 ; i < CD->NumStc - CD->NumMin; i ++){
if ( fabs(x_[i])< 0.3)
tmpconc[i] += x_[i] ;
else{
if (x_[i] < 0)
tmpconc[i] += -0.3;
else
tmpconc[i] += 0.3;
}
// fprintf(stderr, " %s TMPCON %6.4f\t IMPROVE %g\n", CD->chemtype[i].ChemName, tmpconc[i], x_[i]);
error[i] = residue[i]/totconc[i] ;
// fprintf(stderr, " RESI %6.4g\t TOT_CONC %6.4g\t ERROR %6.4g\n", residue[i], totconc[i], error[i] );
}
maxerror = fabs(error[0]);
for ( i = 1; i < CD->NumStc- CD->NumMin; i ++)
if ( fabs(error[i])>maxerror ) maxerror = fabs(error[i]);
control ++;
if (control > 10) return(1);
}
*(NR_times) = control;
denfree(jcb);
// fprintf(stderr, " Solution Reached After %d Newton Ralphson Iterations!\n", control);
for ( i = 0; i < CD->NumSsc; i ++){
tmpval = 0.0;
for ( j = 0 ; j < CD->NumSdc; j ++){
tmpval += (tmpconc[j] + gamma[j])* CD->Dependency[i][j];
}
tmpval -= Keq[i] + gamma[i + CD->NumStc];
tmpconc[i+CD->NumStc] = tmpval;
// fprintf(stderr, " UPDATE %s %6.4f\n", CD->chemtype[i+CD->NumStc].ChemName, (tmpconc[i+CD->NumStc]));
}
for ( i = 0; i < CD->NumStc - CD->NumMin; i ++){
tmpval = 0.0;
for ( j = 0; j < CD->NumStc + CD-> NumSsc; j++){
tmpval+= CD->Totalconc[i][j]*pow(10,tmpconc[j]);
}
totconc[i] = tmpval;
residue[i] = tmpval - CD->Vcele[cell].t_conc[i];
error[i] = residue[i]/totconc[i];
}
/*
for ( i = 0; i < CD->NumStc; i ++){
// fprintf(stderr, " Sum%s: log10(TOTCONC_NR) %4.3f\t log10(TOTCONC_B) %4.3f\t TOTCONC_NR %4.3g\t RESIDUE %2.1g\t RELATIVE ERROR %2.1g\n", CD->chemtype[i].ChemName,log10(totconc[i]),log10(CD->Vcele[cell].t_conc[i]), totconc[i], fabs(residue[i]), fabs(error[i]*100));
}
*/
for ( i = 0; i < CD->NumStc + CD->NumSsc; i ++){
/* if ( tmpconc[i]!=tmpconc[i]){
fprintf(stderr, " Nan type error from reaction at cell %d, species %d", cell+1, i+1);
ReportError(CD->Vcele[cell], CD);
CD->Vcele[cell].illness += 20;
}*/
if ( i < CD->NumStc){
if ( CD->chemtype[i].itype == 4){
CD->Vcele[cell].t_conc[i] += (Rate_spe[i] + Rate_spet[i])*stepsize *0.5;
CD->Vcele[cell].p_actv[i] = 1.0;
CD->Vcele[cell].p_conc[i] = CD->Vcele[cell].t_conc[i];
}
else{
CD->Vcele[cell].p_conc[i] = pow(10,tmpconc[i]);
CD->Vcele[cell].p_actv[i] = pow(10,(tmpconc[i] + gamma[i]));
CD->Vcele[cell].t_conc[i] = totconc[i];
}
}
else{
CD->Vcele[cell].s_conc[i-CD->NumStc] = pow(10,tmpconc[i]);
CD->Vcele[cell].s_actv[i-CD->NumStc] = pow(10,(tmpconc[i] + gamma[i]));
}
// fprintf(stderr, " %s LogC: %6.4f\t C: %6.4f\t Loga: %6.4f\t a: %6.4f\n", CD->chemtype[i].ChemName, tmpconc[i], pow(10, tmpconc[i]), tmpconc[i]+gamma[i], pow(10,(tmpconc[i]+gamma[i])));
}
// if (cell == 700) fprintf(stderr, "Conc. %s %6.4g %6.4g\n",CD->chemtype[19].ChemName, CD->Vcele[cell].s_conc[3], CD->Vcele[cell].s_actv[3]);
/*
for ( i = 0; i < CD->NumStc; i ++){
fprintf(stderr, " Sum%s: log10(TOTCONC_NR) %4.3f\t log10(TOTCONC_B) %4.3f\t TOTCONC_NR %4.3g\t RESIDUE %2.1g\t RELATIVE ERROR %2.1g%\n", CD->chemtype[i].ChemName,log10(totconc[i]),log10(CD->Vcele[cell].t_conc[i]), totconc[i], fabs(residue[i]), fabs(error[i]*100));
}
*/
/* if (( cell == 440) || ( cell == 270) || (cell == 440+535) || ( cell == 270 + 535))
{
fprintf(stderr, " %d React maximum kinetic rate is %10.6g, sat %f, h %f, htot %f, %s is %14.12f!\n",cell, Rate_spe[11], CD->Vcele[cell].sat, CD->Vcele[cell].height_t,CD->Vcele[cell].height_v, CD->chemtype[11].ChemName, CD->Vcele[cell].p_conc[11]);
}
*/
free(residue); free(residue_t); free(tmpconc); free(totconc); free(area); free(error); free(gamma); free(Keq); free(Rate_pre); free(IAP); free(dependency); free(Rate_spe); free(Rate_spe_t); free(Rate_spet); free(p); free(x_);
return(0);
}
int Speciation(Chem_Data CD, int cell){
/* if speciation flg = 1, pH is defined
* if speciation flg = 0, all defined value is total concentration */
int i, j ,k, control, speciation_flg = CD->SPCFlg, num_spe = CD->NumStc + CD->NumSsc ;
double residue[CD->NumStc], residue_t[CD->NumStc], tmpconc[CD->NumStc+CD->NumSsc], totconc[CD->NumStc];
double tmpval, tmpprb= 1E-2, I, Iroot;
double error[CD->NumStc], gamma[num_spe], Keq[CD->NumSsc], current_totconc[CD->NumStc], adh, bdh, bdt;
realtype ** jcb;
if ( CD->TEMcpl == 0 ){
for ( i = 0 ; i < CD->NumSsc; i ++)
Keq[i] = CD->Keq[i];
adh = CD->DH.adh;
bdh = CD->DH.bdh;
bdt = CD->DH.bdt;
}
/*
if ( CD->TEMcpl == 1){
for ( i = 0 ; i < CD->NumSsc; i ++)
Keq[i] = CD->Vcele[cell].Keq[i];
adh = CD->Vcele[cell].DH.adh;
bdh = CD->Vcele[cell].DH.bdh;
bdt = CD->Vcele[cell].DH.bdt;
}
*/
// fprintf(stderr, "\n The activity correction is set to %d.\n", CD->ACTmod);
for ( i = 0; i < CD->NumStc; i ++){
tmpconc[i] = log10(CD->Vcele[cell].p_conc[i]);
}
// using log10 conc as the primary unknowns. works better because negative numbers are not problem.
for ( i = 0; i < CD->NumSsc; i ++){
tmpval = 0.0;
for ( j = 0 ; j < CD->NumSdc; j ++){
tmpval += tmpconc[j]* CD->Dependency[i][j];
}
tmpval -= Keq[i];
tmpconc[i+CD->NumStc] = tmpval;
// fprintf(stderr, " %s %6.4f\t", CD->chemtype[i+CD->NumSpc].ChemName, tmpconc[i+CD->NumSpc]);
}
// initial speciation to get secondary species, no activity corrections
// if ( CD->ACTmod !=1)
for ( i = 0 ; i < num_spe; i ++)
gamma[i] = 0;
for ( i = 0; i < CD->NumStc; i++){
// fprintf(stderr, " Sum%s:%12.10f\t %s:%12.10f\n",CD->chemtype[i].ChemName, log10(CD->Vcele[cell].t_conc[i]), CD->chemtype[i].ChemName,log10( CD->Vcele[cell].p_conc[i]));
current_totconc[i] = CD->Vcele[cell].t_conc[i];
}
if ( speciation_flg ==1){
/* pH is defined, total concentration is calculated from the activity of H */
/* Dependency is the same but the total concentration for H need not be solved */
jcb = denalloc(CD->NumStc -1);
long int p[CD->NumStc-1];
realtype x_[CD->NumStc-1];
double maxerror= 1;
control = 0;
while ( maxerror>TOL){
if ( CD->ACTmod ==1){
I = 0;
// calculate the ionic strength in this block
for ( i = 0 ; i < num_spe; i ++)
I += 0.5 * pow( 10, tmpconc[i]) * sqr(CD->chemtype[i].Charge);
Iroot = sqrt(I);
for ( i = 0 ; i < num_spe; i ++){
if ( CD->chemtype[i].itype == 4) gamma[i] = -tmpconc[i];
// aqueous species in the unit of mol/L, however the solids are in the unit of mol/L porous media
// the activity of solid is 1, the log10 of activity is 0.
// by assigning gamma[minerals] to negative of the tmpconc[minerals], we ensured the log 10 of activity of solids are 0;
else gamma[i] = (-adh * sqr(CD->chemtype[i].Charge) * Iroot)/(1 + bdh * CD->chemtype[i].SizeF * Iroot) + bdt * I;
// fprintf(stderr, " Log10gamma of %s %6.4f\n", CD->chemtype[i].ChemName, gamma[i]);
if ( strcmp(CD->chemtype[i].ChemName, "'H+'")== 0){
tmpconc[i] = log10(CD->Vcele[cell].p_actv[i]) - gamma[i];
// log a = log c + log gamma; log c = log a - log gamma;
}
}
// gamma stores log10gamma[i].
}
// fprintf(stderr, "\n Ionic strength is %6.4f\n", I);
// fprintf(stderr, " Newton Iterations = %d\n\n",control);
for ( i = 0; i < CD->NumSsc; i ++){
tmpval = 0.0;
for ( j = 0 ; j < CD->NumSdc; j ++){
tmpval += (tmpconc[j] + gamma[j])* CD->Dependency[i][j];
}
tmpval -= Keq[i] + gamma[i + CD->NumStc];
tmpconc[i+CD->NumStc] = tmpval;
// fprintf(stderr, " UPDATE %s %6.4f\n", CD->chemtype[i+CD->NumSpc].ChemName, tmpconc[i+CD->NumSpc]);
}
for ( i = 0; i < CD->NumStc; i ++){
tmpval = 0.0;
for ( j = 0; j < num_spe; j++){
tmpval+= CD->Totalconc[i][j]*pow(10,tmpconc[j]);
//fprintf(stderr, " %s %6.4f\t %6.4f\n", CD->chemtype[j].ChemName,CD->Totalconc[i][j], tmpconc[j]);
}
totconc[i] = tmpval;
if ( strcmp(CD->chemtype[i].ChemName, "'H+'") == 0)
CD->Vcele[cell].t_conc[i] = totconc[i];
residue[i] = tmpval - CD->Vcele[cell].t_conc[i];
/* update the total concentration of H+ for later stage RT at initialization */
// fprintf(stderr, " Residue: Sum%s %6.4g\n", CD->chemtype[i].ChemName, residue[i]);
}
int row, col;
col = 0;
for ( k = 0; k < CD->NumStc; k ++){
if ( strcmp(CD->chemtype[k].ChemName, "'H+'")!=0){
tmpconc[k] += tmpprb;
for ( i = 0; i < CD->NumSsc; i ++){
tmpval = 0.0;
for ( j = 0 ; j < CD->NumSdc; j ++)
tmpval += (tmpconc[j]+gamma[j])* CD->Dependency[i][j];
tmpval -= Keq[i] + gamma[i + CD->NumStc];
tmpconc[i+CD->NumStc] = tmpval;
// fprintf(stderr, " CALC_SEC %s %6.4f\t %6.4f\n", CD->chemtype[i+CD->NumStc].ChemName, tmpval, pow(10,tmpconc[i+CD->NumStc]));
}
row = 0;
for ( i = 0; i < CD->NumStc; i ++){
if ( strcmp(CD->chemtype[i].ChemName, "'H+'")!=0){
tmpval = 0.0;
for ( j = 0; j < CD->NumStc + CD-> NumSsc; j++){
tmpval+= CD->Totalconc[i][j]*pow(10,tmpconc[j]);
// fprintf(stderr, " CALC_TOT %s %6.4f\t %6.4f\n",CD->chemtype[j].ChemName, CD->Totalconc[i][j], pow(10,tmpconc[j]));
}
//totconc[i] = tmpval;
// fprintf(stderr, " CALC_TOT Sum%s %6.4f\t %12.10f\n", CD->chemtype[i].ChemName, log10(totconc[i]), totconc[i]);
residue_t[i] = tmpval - CD->Vcele[cell].t_conc[i];
//fprintf(stderr, " %d %d\n",col,row);
jcb[col][row] = (residue_t[i]- residue[i])/(tmpprb);
// fprintf(stderr, "%g\n", jcb[k][i]);
// fprintf(stderr, " Sum%s %6.4f\t %6.4f\n", CD->chemtype[i].ChemName, tmpval, residue_t[i]);
row ++;
}
}
tmpconc[k] -= tmpprb;
col ++;
}
}
row = 0;
for ( i = 0 ; i < CD->NumStc; i ++)
if ( strcmp(CD->chemtype[i].ChemName, "'H+'")!=0)
x_[row++] = - residue[i];
//fprintf(stderr, " Jacobian Matrix!\n");
//denprint(jcb, CD->NumSpc-1);
// fprintf(stderr, " LU flag %ld\n",gefa(jcb,CD->NumStc-1,p));
if(gefa(jcb, CD->NumStc-1, p)!=0){
ReportError(CD->Vcele[cell], CD);
return(1);
// assert(gefa(jcb, CD->NumStc-1, p) == 0 );
}
gesl(jcb, CD->NumStc-1, p, x_);
// gauss(jcb, x_, CD->NumStc-1);
// assert(gefa(jcb, CD->NumStc-1, p)==0);
row = 0;
for (i = 0 ; i < CD->NumStc; i ++){
if ( strcmp(CD->chemtype[i].ChemName, "'H+'")!=0)
tmpconc[i] += x_[row++] ;
// fprintf(stderr, " %s %6.4f\t %6.4f\n", CD->chemtype[i].ChemName, tmpconc[i], x_[i]);
error[i] = residue[i]/totconc[i];
}
maxerror = fabs(error[0]);
for ( i = 1; i < CD->NumStc; i ++)
if ( fabs(error[i])>maxerror ) maxerror = fabs(error[i]);
control ++;
}
}
if ( speciation_flg ==0){
// fprintf(stderr, " \n\nTotal H+\n\n");
jcb = denalloc(CD->NumStc);
long int p[CD->NumStc];
realtype x_[CD->NumStc];
control =0;
double maxerror= 1;
while ( maxerror > TOL){
if ( CD->ACTmod ==1){
I = 0.0;
// calculate the ionic strength in this block
for ( i = 0 ; i < num_spe; i ++){
I += 0.5 * pow( 10, tmpconc[i]) * sqr(CD->chemtype[i].Charge);
// fprintf(stderr, " I_CALC, %s: %6.4f\t %6.4f\n",CD->chemtype[i].ChemName, pow(10,tmpconc[i]), sqr(CD->chemtype[i].Charge));
}
Iroot = sqrt(I);
for ( i = 0 ; i < num_spe; i ++){
if ( CD->chemtype[i].itype == 4) gamma[i] = - tmpconc[i];
else gamma[i] = ( - adh * sqr(CD->chemtype[i].Charge) * Iroot)/(1 + bdh * CD->chemtype[i].SizeF * Iroot) + bdt * I;
// fprintf(stderr, " Log10gamma of %s %6.4f\n", CD->chemtype[i].ChemName, gamma[i]);
// log a = log c + log gamma; log c = log a - log gamma;
}
}
// gamma stores log10gamma[i].
// fprintf(stderr, "\n Ionic strength is %6.4f\n", I);
// fprintf(stderr, "\n NEWTON ITERATION = %d\n",control);
for ( i = 0; i < CD->NumSsc; i ++){
tmpval = 0.0;
for ( j = 0 ; j < CD->NumSdc; j ++){
tmpval += (tmpconc[j] + gamma[j])* CD->Dependency[i][j];
}
tmpval -= Keq[i] + gamma[i + CD->NumStc];
tmpconc[i+CD->NumStc] = tmpval;
// fprintf(stderr, " UPDATE %s %6.4f\n", CD->chemtype[i+CD->NumStc].ChemName, tmpconc[i+CD->NumStc]);
}
for ( i = 0; i < CD->NumStc; i ++){
tmpval = 0.0;
for ( j = 0; j < CD->NumStc + CD-> NumSsc; j++){
tmpval+= CD->Totalconc[i][j]*pow(10,tmpconc[j]);
// fprintf(stderr, " %s %6.4f\t %6.4f\n", CD->chemtype[j].ChemName,CD->Totalconc[i][j], tmpconc[j]);
}
totconc[i] = tmpval;
residue[i] = tmpval - CD->Vcele[cell].t_conc[i];
// fprintf(stderr, " Residue: Sum%s %6.4f\n", CD->chemtype[i].ChemName, residue[i]);
}
for ( k = 0; k < CD->NumStc; k ++){
tmpconc[k] += tmpprb;
for ( i = 0; i < CD->NumSsc; i ++){
tmpval = 0.0;
for ( j = 0 ; j < CD->NumSdc; j ++)
tmpval += (tmpconc[j]+ gamma[j])* CD->Dependency[i][j];
tmpval -= Keq[i] + gamma[i+ CD->NumStc];
tmpconc[i+CD->NumStc] = tmpval;
// fprintf(stderr, " CALC_SEC %s %6.4f\t %6.4f\n", CD->chemtype[i+CD->NumSpc].ChemName, tmpval, pow(10,tmpconc[i+CD->NumSpc]));
}
for ( i = 0; i < CD->NumStc; i ++){
tmpval = 0.0;
for ( j = 0; j < CD->NumStc + CD-> NumSsc; j++){
tmpval+= CD->Totalconc[i][j]*pow(10,tmpconc[j]);
// fprintf(stderr, " CALC_TOT %s %6.4f\t %6.4f\n",CD->chemtype[j].ChemName, CD->Totalconc[i][j], pow(10,tmpconc[j]));
}
// totconc[i] = tmpval;
//fprintf(stderr, " CALC_TOT Sum%s %6.4f\t %12.10f\n", CD->chemtype[i].ChemName, log10(totconc[i]), totconc[i]);
residue_t[i] = tmpval - CD->Vcele[cell].t_conc[i];
jcb[k][i] = (residue_t[i]- residue[i])/(tmpprb);
// fprintf(stderr, "%g\n", jcb[k][i]);
// fprintf(stderr, " Sum%s %6.4f\t %6.4f\n", CD->chemtype[i].ChemName, tmpval, residue_t[i]);
}
tmpconc[k] -= tmpprb;
}
for ( i = 0 ; i < CD->NumStc; i ++)
x_[i] = - residue[i];
// fprintf(stderr, " Jacobian Matrix!\n");
// denprint(jcb, CD->NumSpc);
if(gefa(jcb, CD->NumStc, p)!=0){
ReportError(CD->Vcele[cell], CD);
return(1);
// assert(gefa(jcb, CD->NumStc, p) == 0 );
}
// fprintf(stderr, " LU %ld\n",gefa(jcb,CD->NumStc,p));
gesl(jcb, CD->NumStc, p, x_);
// gauss(jcb, x_, CD->NumStc);
for (i = 0 ; i < CD->NumStc; i ++){
tmpconc[i] += x_[i] ;
// fprintf(stderr, " %s TMPCON %6.4f\t IMPROVE %g", CD->chemtype[i].ChemName, tmpconc[i], x_[i]);
error[i] = residue[i]/totconc[i] ;
// fprintf(stderr, " RESI %6.4g\t TOT_CONC %6.4g\t ERROR %6.4g\n", residue[i], totconc[i], error[i] );
}
maxerror = fabs(error[0]);
for ( i = 1; i < CD->NumStc; i ++)
if ( fabs(error[i])>maxerror ) maxerror = fabs(error[i]);
control ++;
}
}
// fprintf(stderr, " Solution Reached!\n");
for ( i = 0; i < CD->NumSsc; i ++){
tmpval = 0.0;
for ( j = 0 ; j < CD->NumSdc; j ++){
tmpval += (tmpconc[j] + gamma[j])* CD->Dependency[i][j];
}
tmpval -= Keq[i] + gamma[i + CD->NumStc];
tmpconc[i+CD->NumStc] = tmpval;
// fprintf(stderr, " UPDATE %s %6.4f\n", CD->chemtype[i+CD->NumStc].ChemName, (tmpconc[i+CD->NumStc]));
}
for ( i = 0; i < CD->NumStc; i ++){
tmpval = 0.0;
for ( j = 0; j < CD->NumStc + CD-> NumSsc; j++){
tmpval+= CD->Totalconc[i][j]*pow(10,tmpconc[j]);
// fprintf(stderr, " %s %6.4f\t %6.4f\n", CD->chemtype[j].ChemName,CD->Totalconc[i][j], tmpconc[j]);
}
totconc[i] = tmpval;
residue[i] = tmpval - CD->Vcele[cell].t_conc[i];
error[i] = residue[i]/totconc[i];
// fprintf(stderr, " Residue: Sum%s %6.4f\n", CD->chemtype[i].ChemName, residue[i]);
}
for ( i = 0; i < CD->NumStc + CD->NumSsc; i ++){
if ( i < CD->NumStc){
if ( CD->chemtype[i].itype == 4){
CD->Vcele[cell].p_conc[i] = pow(10,tmpconc[i]);
CD->Vcele[cell].p_actv[i] = 1.0;
}
else{
CD->Vcele[cell].p_conc[i] = pow(10,tmpconc[i]);
CD->Vcele[cell].p_actv[i] = pow(10,(tmpconc[i] + gamma[i]));
}
}
else{
CD->Vcele[cell].s_conc[i-CD->NumStc] = pow(10,tmpconc[i]);
CD->Vcele[cell].s_actv[i-CD->NumStc] = pow(10,(tmpconc[i] + gamma[i]));
}
// fprintf(stderr, " %s LogC: %6.4f\t C: %6.4f\t Loga: %6.4f\t a: %6.4f\n", CD->chemtype[i].ChemName, tmpconc[i], pow(10, tmpconc[i]), tmpconc[i]+gamma[i], pow(10, tmpconc[i]+gamma[i]));
}
// for ( i = 0; i < CD->NumStc; i ++){
// fprintf(stderr, " Sum%s: log10(TOTCONC_NR) %4.3f\t log10(TOTCONC_B) %4.3f\t TOTCONC_NR %4.3g\t RESIDUE %2.1g\t RELATIVE ERROR %2.1g\n", CD->chemtype[i].ChemName,log10(totconc[i]),log10(CD->Vcele[cell].t_conc[i]), totconc[i], fabs(residue[i]), fabs(error[i]*100));
// }
denfree(jcb);
return(0);
}
/* Preconditioner setup routine. Generate and preprocess P. */
static int Precond(realtype tn, N_Vector u, N_Vector fu,
booleantype jok, booleantype *jcurPtr,
realtype gamma, void *P_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco;
realtype **(*P)[MYSUB], **(*Jbd)[MYSUB];
long int nvmxsub, *(*pivot)[MYSUB], ier, offset;
int lx, ly, jx, jy, isubx, isuby;
realtype *udata, **a, **j;
PreconData predata;
UserData data;
/* Make local copies of pointers in P_data, pointer to u's data,
and PE index pair */
predata = (PreconData) P_data;
data = (UserData) (predata->f_data);
P = predata->P;
Jbd = predata->Jbd;
pivot = predata->pivot;
udata = NV_DATA_P(u);
isubx = data->isubx; isuby = data->isuby;
nvmxsub = data->nvmxsub;
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (ly = 0; ly < MYSUB; ly++)
for (lx = 0; lx < MXSUB; lx++)
dencopy(Jbd[lx][ly], P[lx][ly], NVARS);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (ly = 0; ly < MYSUB; ly++) {
jy = ly + isuby*MYSUB;
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*EXP(RCONST(0.2)*ydn);
cyup = verdco*EXP(RCONST(0.2)*yup);
diag = -(cydn + cyup + RCONST(2.0)*hordco);
for (lx = 0; lx < MXSUB; lx++) {
jx = lx + isubx*MXSUB;
offset = lx*NVARS + ly*nvmxsub;
c1 = udata[offset];
c2 = udata[offset+1];
j = Jbd[lx][ly];
a = P[lx][ly];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
dencopy(j, a, NVARS);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (ly = 0; ly < MYSUB; ly++)
for (lx = 0; lx < MXSUB; lx++)
denscale(-gamma, P[lx][ly], NVARS);
/* Add identity matrix and do LU decompositions on blocks in place */
for (lx = 0; lx < MXSUB; lx++) {
for (ly = 0; ly < MYSUB; ly++) {
denaddI(P[lx][ly], NVARS);
ier = gefa(P[lx][ly], NVARS, pivot[lx][ly]);
if (ier != 0) return(1);
}
}
return(0);
}
static int PrecondB(realtype t, N_Vector c,
N_Vector cB, N_Vector fcB, booleantype jok,
booleantype *jcurPtr, realtype gamma,
void *P_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
long int N;
realtype ***P;
long int **pivot, ier;
int i, if0, if00, ig, igx, igy, j, jj, jx, jy;
int *jxr, *jyr, mp, ngrp, ngx, ngy, mxmp, flag;
realtype uround, fac, r, r0, save, srur;
realtype *f1, *fsave, *cdata, *rewtdata;
void *cvode_mem;
WebData wdata;
N_Vector rewt;
wdata = (WebData) P_data;
cvode_mem = CVadjGetCVodeBmem(wdata->cvadj_mem);
if(check_flag((void *)cvode_mem, "CVadjGetCVodeBmem", 0)) return(1);
rewt = wdata->rewt;
flag = CVodeGetErrWeights(cvode_mem, rewt);
if(check_flag(&flag, "CVodeGetErrWeights", 1)) return(1);
cdata = NV_DATA_S(c);
rewtdata = NV_DATA_S(rewt);
uround = UNIT_ROUNDOFF;
P = wdata->P;
pivot = wdata->pivot;
jxr = wdata->jxr;
jyr = wdata->jyr;
mp = wdata->mp;
srur = wdata->srur;
ngrp = wdata->ngrp;
ngx = wdata->ngx;
ngy = wdata->ngy;
mxmp = wdata->mxmp;
fsave = wdata->fsave;
/* Make mp calls to fblock to approximate each diagonal block of Jacobian.
Here, fsave contains the base value of the rate vector and
r0 is a minimum increment factor for the difference quotient. */
f1 = NV_DATA_S(vtemp1);
fac = N_VWrmsNorm (fcB, rewt);
N = NEQ;
r0 = RCONST(1000.0)*ABS(gamma)*uround*N*fac;
if (r0 == ZERO) r0 = ONE;
for (igy = 0; igy < ngy; igy++) {
jy = jyr[igy];
if00 = jy*mxmp;
for (igx = 0; igx < ngx; igx++) {
jx = jxr[igx];
if0 = if00 + jx*mp;
ig = igx + igy*ngx;
/* Generate ig-th diagonal block */
for (j = 0; j < mp; j++) {
/* Generate the jth column as a difference quotient */
jj = if0 + j;
save = cdata[jj];
r = MAX(srur*ABS(save),r0/rewtdata[jj]);
cdata[jj] += r;
fac = gamma/r;
fblock (t, cdata, jx, jy, f1, wdata);
for (i = 0; i < mp; i++) {
P[ig][i][j] = (f1[i] - fsave[if0+i])*fac;
}
cdata[jj] = save;
}
}
}
/* Add identity matrix and do LU decompositions on blocks. */
for (ig = 0; ig < ngrp; ig++) {
denaddI(P[ig], mp);
ier = gefa(P[ig], mp, pivot[ig]);
if (ier != 0) return(1);
}
*jcurPtr = TRUE;
return(0);
}
