/// <summary>
/// Thomases the specified istart.
/// </summary>
/// <param name="istart">The istart.</param>
/// <param name="n">The n.</param>
/// <param name="a">a.</param>
/// <param name="b">The b.</param>
/// <param name="c">The c.</param>
/// <param name="rhs">The RHS.</param>
/// <param name="d">The d.</param>
/// <param name="v">The v.</param>
/// <param name="pondingData">The ponding data.</param>
/// <param name="fail">if set to <c>true</c> [fail].</param>
private void Thomas(int istart, int n, ref double[] a, ref double[] b, ref double[] c, ref double[] rhs, ref double[] d, ref double[] v, ref PondingData pondingData, out bool fail)
{
// Short description:
// Thomas algorithm for solving tridiagonal system of eqns
fail = true; // Indicate failure if we return early
double piv = b[istart];
if (istart == -1)
piv = pondingData.b;
if (piv == 0.0)
return;
if (istart == -1)
pondingData.v = pondingData.rhs / piv;
else
v[istart] = rhs[istart] / piv;
for (int i = istart + 1; i < istart + n; i++)
{
if (i == 0)
d[i] = pondingData.c / piv;
else
d[i] = c[i - 1] / piv;
piv = b[i] - a[i] * d[i];
if (piv == 0.0)
return;
if (i == 0)
v[i] = (rhs[i] - a[i] * pondingData.v) / piv;
else
v[i] = (rhs[i] - a[i] * v[i - 1]) / piv;
}
for (int i = istart + n - 2; i >= istart; i--)
{
if (i == -1)
pondingData.v = pondingData.v - d[i + 1] * v[i + 1];
else
v[i] = v[i] - d[i + 1] * v[i + 1];
}
fail = false;
}
/// <summary>
/// Gets the sol.
/// </summary>
/// <param name="solnum">The solnum.</param>
/// <param name="a">a.</param>
/// <param name="b">The b.</param>
/// <param name="c">The c.</param>
/// <param name="d">The d.</param>
/// <param name="rhs">The RHS.</param>
/// <param name="c1">The c1.</param>
/// <param name="c2">The c2.</param>
/// <param name="pondingData">The ponding data.</param>
/// <param name="fail">if set to <c>true</c> [fail].</param>
private void GetSol(int solnum, ref double[] a, ref double[] b, ref double[] c, ref double[] d, ref double[] rhs, ref double[] c1, ref double[] c2, ref PondingData pondingData, ref bool fail)
{
// Short description:
// get and solve solute balance eqns
// Constant Values
const int itmax = 20;
const int constant_conc = 1;
const int convection_only = 2;
// Determine type of solute BBC to use
int solute_bbc;
int j;
double rslovr;
bool nonlin = false;
double wtime = 0.0, wtime1 = 0.0;
if (ibbc == 1)
// water table boundary condition
solute_bbc = constant_conc;
else if (((ibbc == 0) || (ibbc == 4)) && (q[n + 1] < 0))
// you have a gradient with flow upward
solute_bbc = constant_conc;
else
solute_bbc = convection_only;
// surface solute balance - assume evap. (g%res) comes from x0 store
double rovr = roff + qbp;
double rinf = q[0] + res;
if (rinf > Math.Min(ersoil, ernode))
{
cslsur[solnum] = (rslon[solnum] + hold * cslsur[solnum] / _dt) / (rovr + rinf + _h / _dt);
qsl[solnum][0] = rinf * cslsur[solnum];
rslovr = rovr * cslsur[solnum];
if (slsur[solnum] > 0.0)
{
if (cslsur[solnum] < slsci[solnum])
{
if (slsur[solnum] > rinf * _dt * (slsci[solnum] - cslsur[solnum]))
{
qsl[solnum][0] = rinf * slsci[solnum];
slsur[solnum] = slsur[solnum] - rinf * _dt * (slsci[solnum] - cslsur[solnum]);
}
else
{
qsl[solnum][0] = rinf * cslsur[solnum] + slsur[solnum] / _dt;
slsur[solnum] = 0.0;
}
}
if (cslsur[solnum] < slscr[solnum])
{
if (slsur[solnum] > rovr * _dt * (slscr[solnum] - cslsur[solnum]))
{
rslovr = rovr * slscr[solnum];
slsur[solnum] = slsur[solnum] - rovr * _dt * (slscr[solnum] - cslsur[solnum]);
}
else
{
rslovr = rovr * cslsur[solnum] + slsur[solnum] / _dt;
slsur[solnum] = 0.0;
}
if (slsur[solnum] > _h * (slscr[solnum] - cslsur[solnum]))
{
slsur[solnum] = slsur[solnum] - _h * (slscr[solnum] - cslsur[solnum]);
cslsur[solnum] = slscr[solnum];
}
else
{
if (_h > 0.0)
cslsur[solnum] = cslsur[solnum] + slsur[solnum] / _h;
slsur[solnum] = 0.0;
}
}
}
}
else
{
cslsur[solnum] = 0.0;
qsl[solnum][0] = 0.0;
rslovr = 0.0;
}
// get eqn coeffs
// get production and storage components
double thi;
double exco1;
//nh call slprod
for (int i = 0; i <= n; i++)
{
c1[i] = csl[solnum][i];
thi = th[i];
//nh j=indxsl(solnum,i)
j = i;
nonlin = false;
//Peter's CHANGE 21/10/98 to ensure zero exchange is treated as linear
// if (p%fip(solnum,j).eq.1.) then
if ((MathUtilities.FloatsAreEqual(ex[solnum][j], 0.0)) || (MathUtilities.FloatsAreEqual(fip[solnum][j], 1.0)))
{
// linear exchange isotherm
c2[i] = 1.0;
exco1 = ex[solnum][j];
}
else
{
// nonlinear Freundlich exchange isotherm
nonlin = true;
c2[i] = 0.0;
if (c1[i] > 0.0)
c2[i] = Math.Pow(c1[i], fip[solnum][i] - 1.0);
//``````````````````````````````````````````````````````````````````````````````````````````````````
//RC Changed by RCichota 30/jan/2010
exco1 = ex[solnum][j] * c2[i];
// exco1=p%ex(solnum,j)*p%fip(solnum,j)*c2(i) !<---old code
//
}
b[i] = (-(thi + exco1) / _dt) * dx[i] - qssof[i];
//nh 1 apswim_slupf(1,solnum)*g%qex(i)-g%qssof(i)
for (int crop = 0; crop < num_crops; crop++)
b[i] = b[i] - Slupf(crop, solnum) * qr[i][crop];
//nh 1 p%slupf(solnum)*g%qex(i)
rhs[i] = -(csl[solnum][i] * ((thold[i] + exco1) / _dt)) * dx[i];
qsls[solnum][i] = -(csl[solnum][i] * (thold[i] + ex[solnum][j] * c2[i]) / _dt) * dx[i];
}
// get dispersive and convective components
// use central diffs in time for convection, backward diffs for rest
// use central diffs in space, but for convection may need some
// upstream weighting to avoid instability
for (int i = 1; i <= n; i++) // NOTE: staring from 1 is deliberate this time
{
if (!MathUtilities.FloatsAreEqual(x[i - 1], x[i]))
{
double w1;
double thav = 0.5 * (th[i - 1] + th[i]);
double aq = Math.Abs(q[i]);
dc[solnum][i] = dcon[solnum] * Math.Pow(thav - SwimSoluteParameters.DTHC, SwimSoluteParameters.DTHP) +
SwimSoluteParameters.Dis * Math.Pow(aq / thav, SwimSoluteParameters.Disp);
double dfac = thav * dc[solnum][i] / (x[i] - x[i - 1]);
if (slswt >= 0.5 && slswt <= 1.0)
{
// use fixed space weighting on convection
w1 = MathUtilities.Sign(2.0 * slswt, q[i]);
}
else
{
// use central diffs for convection if possible, else use
// just enough upstream weighting to avoid oscillation
// user may increase acceptable level for central diffs
// by setting p%slswt < -1
double accept = Math.Max(1.0, -slswt);
double wt = 0.0;
if (aq != 0.0)
wt = MathUtilities.Sign(Math.Max(0.0, 1.0 - 2.0 * accept * dfac / aq), q[i]);
w1 = 1.0 + wt;
}
double w2 = 2.0 - w1;
//Peter's CHANGE 21/10/98 to remove/restore Crank-Nicolson time weighting
//for convection
// fq=.25*g%q(i)
// fqc=fq*(w1*g%csl(solnum,i-1)+w2*g%csl(solnum,i))
// wtime=0.25D0
// wtime1=1.0D0
wtime = 0.5;
wtime1 = 0.0;
double fq = wtime * q[i];
double fqc = wtime1 * fq * (w1 * csl[solnum][i - 1] + w2 * csl[solnum][i]);
// get convective component from old time level
qsl[solnum][i] = fqc;
b[i - 1] = b[i - 1] - dfac - fq * w1;
c[i - 1] = dfac - fq * w2;
a[i] = dfac + fq * w1;
b[i] = b[i] - dfac + fq * w2;
rhs[i - 1] = rhs[i - 1] + fqc;
rhs[i] = rhs[i] - fqc;
}
}
// allow for bypass flow
qslbp[solnum] = 0.0;
// impose boundary conditions
int k;
if (itbc == 1)
{
// constant concentration
k = 1;
}
else
{
k = 0;
rhs[0] = rhs[0] - qsl[solnum][0];
if (rinf < -Math.Min(ersoil, ernode))
{
b[0] = b[0] + 0.5 * rinf;
rhs[0] = rhs[0] - 0.5 * rinf * csl[solnum][0];
}
}
int neq;
if (solute_bbc == constant_conc)
{
// constant concentration
//nh
csl[solnum][n] = cslgw[solnum];
//nh
rhs[n - 1] = rhs[n - 1] - c[n - 1] * csl[solnum][n];
neq = n;
}
else
{
// convection only
b[n] = b[n] - 0.5 * q[n + 1];
rhs[n] = rhs[n] + 0.5 * q[n + 1] * csl[solnum][n];
neq = n + 1;
}
// allow for two nodes at same depth
j = 0;
for (int i = 1; i <= n; i++)
{
if (!MathUtilities.FloatsAreEqual(x[i - 1], x[i]))
{
j = j + 1;
a[j] = a[i];
b[j] = b[i];
rhs[j] = rhs[i];
c[j - 1] = c[i - 1];
}
else
{
b[j] = b[j] + b[i];
rhs[j] = rhs[j] + rhs[i];
}
}
// save old g%csl(0),g%csl(p%n)
double csl0 = csl[solnum][0];
double csln = csl[solnum][n];
neq = neq - (n - j);
int itcnt = 0;
// solve for concentrations
loop:
//nh call thomas(neq,0,a(k),b(k),c(k),rhs(k),dum,d(k),g%csl(solnum,k),
//nh : dum,fail)
double[] csltemp = new double[n + 1];
for (int i = 0; i <= n; i++)
csltemp[i] = csl[solnum][i];
Thomas(k, neq, ref a, ref b, ref c, ref rhs, ref d, ref csltemp, ref pondingData, out fail);
for (int i = 0; i <= n; i++)
csl[solnum][i] = csltemp[i];
// nh end subroutine
itcnt++;
slwork = slwork + neq;
if (fail)
return;
j = k + neq - 1;
if (solute_bbc == convection_only)
{
csl[solnum][n] = csl[solnum][j];
j--;
}
for (int i = n - 1; i > 0; i--)
{
if (!MathUtilities.FloatsAreEqual(x[i], x[i + 1]))
{
csl[solnum][i] = csl[solnum][j];
j--;
}
else
{
csl[solnum][i] = csl[solnum][i + 1];
}
}
if (nonlin)
{
// test for convergence
double dmax = 0.0;
for (int i = 0; i <= n; i++)
{
double dabs = Math.Abs(csl[solnum][i] - c1[i]);
if (dmax < dabs)
dmax = dabs;
}
if (dmax > slcerr)
{
if (itcnt == itmax)
{
fail = true;
return;
}
// keep iterating using Newton-Raphson technique
// next c^fip for Freundlich isotherm is approximated as
// cn^fip=c^fip+p%fip*c^(p%fip-1)*(cn-c)
// =p%fip*c^(p%fip-1)*cn+(1-p%fip)*c^fip
j = 0;
for (int i = 0; i <= n; i++)
{
if (!MathUtilities.FloatsAreEqual(x[i - 1], x[i]))
{
if (i > 0)
j++;
}
//cnh kk=indxsl(solnum,i)
int kk = i;
if (!MathUtilities.FloatsAreEqual(fip[solnum][i], 1.0))
{
double cp = 0.0;
if (csl[solnum][i] > 0.0)
cp = Math.Pow(csl[solnum][i], fip[solnum][i] - 1.0);
//````````````````````````````````````````````````````````````````````````````````````````````````````````````````
//RC Changed by RCichota (29/Jan/2010), original code is commented out
double d1 = cp - c2[i];
// d1=p%fip(solnum,kk)*(cp-c2(i))
// d2=(1.-p%fip(solnum,kk))
// : *(g%csl(solnum,i)*cp-c1(i)*c2(i))
c1[i] = csl[solnum][i];
c2[i] = cp;
b[j] = b[j] - (ex[solnum][kk] / _dt) * d1 * dx[i];
// rhs(j)=rhs(j)+(p%ex(solnum,kk)/g%dt
// : -p%betaex(solnum,kk))
// : *d2*p%dx(i)
//````````````````````````````````````````````````````````````````````````````````````````````````````````````````
// Changes in the calc of d1 are to agree with the calc of exco1 above (no need to multiply by p%fip
// If p%fip < 1, the unkown is Cw, and is only used in the calc of b. thus rhs is commented out.
//`
}
}
goto loop;
}
}
// get surface solute balance?
if (rinf < -Math.Min(ersoil, ernode))
{
// flow out of surface
//CHANGES 6/11/98 to remove/restore Crank-Nicolson time weighting for convection
//-----
// g%qsl(solnum,0)=.5*rinf*(csl0+g%csl(solnum,0))
qsl[solnum][0] = 0.5 * rinf * (wtime1 * csl0 + 4.0 * wtime * csl[solnum][0]);
double rslout = -qsl[solnum][0];
if (slsur[solnum] > 0.0)
{
// allow for surface applied solute
if (csl[solnum][0] < slsci[solnum])
{
if (slsur[solnum] > -rinf * _dt * (slsci[solnum] - csl[solnum][0]))
{
rslout = -rinf * slsci[solnum];
slsur[solnum] = slsur[solnum] + rinf * _dt * (slsci[solnum] - csl[solnum][0]);
}
else
{
rslout = rslout + slsur[solnum] / _dt;
slsur[solnum] = 0.0;
}
}
}
// get surface solute balance
cslsur[solnum] = (rslon[solnum] + rslout + hold * cslsur[solnum] / _dt) / (rovr + _h / _dt);
rslovr = rovr * cslsur[solnum];
}
rsloff[solnum] = rslovr - qslbp[solnum];
// get solute fluxes
for (int i = 1; i <= n; i++)
{
if (!MathUtilities.FloatsAreEqual(x[i - 1], x[i]))
{
double dfac = 0.5 * (th[i - 1] + th[i]) * dc[solnum][i] / (x[i] - x[i - 1]);
double aq = Math.Abs(q[i]);
double accept = Math.Max(1.0, -slswt);
double wt = 0.0;
if (aq != 0.0)
wt = MathUtilities.Sign(Math.Max(0.0, 1.0 - 2.0 * accept * dfac / aq), q[i]);
//Peter's CHANGES 21/10/98 to remove/restore Crank-Nicolson time weighting
//for convection
// g%qsl(solnum,i)=g%qsl(solnum,i)
// : +.25*g%q(i)*((1.+wt)*g%csl(solnum,i-1)
// : +(1.-wt)*g%csl(solnum,i))
// 1 +dfac*(g%csl(solnum,i-1)-g%csl(solnum,i))
qsl[solnum][i] = qsl[solnum][i] + wtime * q[i] * ((1.0 + wt) * csl[solnum][i - 1]
+ (1.0 - wt) * csl[solnum][i]) + dfac * (csl[solnum][i - 1] - csl[solnum][i]);
}
}
for (int i = 2; i < n; i++)
{
if (MathUtilities.FloatsAreEqual(x[i - 1], x[i]))
{
qsl[solnum][i] = (dx[i] * qsl[solnum][i - 1] + dx[i - 1] * qsl[solnum][i + 1]) / (dx[i - 1] + dx[i]);
}
}
rslex[solnum] = 0.0;
for (int i = 0; i <= n; i++)
{
//nh j=indxsl(solnum,i)
j = i;
double cp = 1.0;
if (!MathUtilities.FloatsAreEqual(fip[solnum][i], 1.0))
{
cp = 0.0;
if (csl[solnum][i] > 0.0)
cp = Math.Pow(csl[solnum][i], fip[solnum][i] - 1.0);
}
cslt[solnum][i] = (th[i] + ex[solnum][j] * cp) * csl[solnum][i];
for (int crop = 0; crop < num_crops; crop++)
rslex[solnum] += qr[i][crop] * csl[solnum][i] * Slupf(crop, solnum);
qsls[solnum][i] += (csl[solnum][i] * (thold[i] + ex[solnum][j] * cp) / _dt) * dx[i];
}
if (solute_bbc == constant_conc)
{
// constant concentration
//nh j=indxsl(solnum,p%n)
j = n;
qsl[solnum][n + 1] = qsl[solnum][n] - qsls[solnum][n] - qssof[n] * csl[solnum][n];
//nh : -g%qex(p%n)*g%csl(solnum,p%n)*p%slupf(solnum)
//nh : -g%qex(p%n)*g%csl(solnum,p%n)*apswim_slupf(1,solnum)
for (int crop = 0; crop < num_crops; crop++)
qsl[solnum][n + 1] -= qr[n][crop] * csl[solnum][n] * Slupf(crop, solnum);
}
else
{
// convection only
//CHANGES 6/11/98 to remove/restore Crank-Nicolson time weighting for convection
//-----
// g%qsl(solnum,p%n+1)=.5*g%q(p%n+1)*(csln+g%csl(solnum,p%n))
qsl[solnum][n + 1] = 0.5 * q[n + 1] * (wtime1 * csln + 4.0 * wtime * csl[solnum][n]);
}
}
/// <summary>
/// Solves the specified itlim.
/// </summary>
/// <param name="itlim">The itlim.</param>
/// <param name="fail">if set to <c>true</c> [fail].</param>
private void Solve(int itlim, ref bool fail)
{
// Short description:
// solves for this time step
int it = 0;
double wpold = _wp;
int iroots = 0;
// loop until solved or too many iterations or Thomas algorithm fails
int i1;
int i2;
double[] a = new double[n + 1];
double[] b = new double[n + 1];
double[] c = new double[n + 1];
double[] d = new double[n + 1];
double[] rhs = new double[n + 1];
double[] dp = new double[n + 1];
double[] vbp = new double[n + 1];
PondingData pondingData = new PondingData();
do
{
it++;
// get balance eqns
// LOOK OUT. THE FORTRAN CODE USED ARRAY INDICES STARTING AT -1
Baleq(it, ref iroots, ref slos, ref csl, out i1, out i2, ref a, ref b, ref c, ref rhs, ref pondingData);
// test for convergence to soln
// nh hey - wpf has no arguments !
// nh _wp = wpf(n, _dx, th)
_wp = Wpf();
double balerr = ron - roff - q[n + 1] - rex - res + rssf - (_h - hold + _wp - wpold) / _dt;
double err = 0.0;
for (int i = i1; i <= i2; i++)
{
double aerr = Math.Abs(rhs[i]);
if (err < aerr)
err = aerr;
}
// switch off iteration for root extraction if err small enough
if (err < errex * rex && iroots == 0)
iroots = 1;
if (Math.Abs(balerr) < ersoil && err < ernode)
fail = false;
else
{
int neq = i2 - i1 + 1;
Thomas(i1, neq, ref a, ref b, ref c, ref rhs, ref d, ref dp, ref pondingData, out fail);
_work += neq;
//nh if(fail)go to 90
if (fail)
{
//nh call warning_error(Err_internal,
//nh : 'swim will reduce timestep to solve water movement')
summary.WriteMessage(this, "swim will reduce timestep to avoid error in water balance");
break;
}
fail = true;
// limit step size_of for soil nodesn
int i0 = Math.Max(i1, 0);
for (int i = i0; i <= i2; i++)
{
if (dp[i] > dppl)
dp[i] = dppl;
if (dp[i] < -dpnl)
dp[i] = -dpnl;
}
// update solution
int j = i0;
for (int i = i0; i <= i2; i++)
{
_p[j] += dp[i];
if (j > 0 && j < n - 1)
{
if (MathUtilities.FloatsAreEqual(x[j], x[j + 1]))
{
j++;
_p[j] = _p[j - 1];
}
}
j++;
}
if (i1 == -1)
_h = Math.Max(0.0, _h + pondingData.v);
//_h = Math.Max(0.0, _h + dp[-1]);
}
}
while (fail && it < itlim);
if (fail)
{
summary.WriteMessage(this, clock.Today.ToString("dd-mmm-yyyy"));
summary.WriteMessage(this, "Maximum iterations reached - swim will reduce timestep");
}
// solve for solute movement
else
{
for (int solnum = 0; solnum < num_solutes; solnum++)
{
GetSol(solnum, ref a, ref b, ref c, ref d, ref rhs, ref dp, ref vbp, ref pondingData, ref fail);
if (fail)
{
summary.WriteMessage(this, "swim will reduce timestep to solve solute movement");
break;
}
}
}
}
/// <summary>
/// Baleqs the specified it.
/// </summary>
/// <param name="it">It.</param>
/// <param name="iroots">The iroots.</param>
/// <param name="tslos">The tslos.</param>
/// <param name="tcsl">The TCSL.</param>
/// <param name="ibegin">The ibegin.</param>
/// <param name="iend">The iend.</param>
/// <param name="a">a.</param>
/// <param name="b">The b.</param>
/// <param name="c">The c.</param>
/// <param name="rhs">The RHS.</param>
/// <param name="pondingData">The ponding data.</param>
private void Baleq(int it, ref int iroots, ref double[] tslos, ref double[][] tcsl, out int ibegin, out int iend, ref double[] a, ref double[] b, ref double[] c, ref double[] rhs, ref PondingData pondingData)
{
// Short Description:
// gets coefficient matrix and rhs for Newton soln of balance eqns
//
// Some variables had the same name as some global variables and so
// these were renamed (by prefixing with g%t - for temp)
// this include p%isol, g%csl, p%slos
const double hcon = 7.0e-7;
const double hair = 0.5;
double[] psip = new double[n + 1];
double[] psipp = new double[n + 1];
double[] thp = new double[n + 1];
double[] hkp = new double[n + 1];
double[] qsp = new double[n + 1];
double[] qp1 = new double[n + 2];
double[] qp2 = new double[n + 2];
double[] psios = new double[n + 1];
double[,] qexp = new double[3, n + 1];
double[] qdrain = new double[n + 1];
double[] qdrainpsi = new double[n + 1];
double[] qssofp = new double[n + 1];
double v1;
// initialise for first iteration
if (it == 1)
{
ifirst = 0;
ilast = n;
if (itbc == 2 && hold > 0.0)
ifirst = -1;
if (ibbc == 0)
gr = bbc_value;
if (ibbc == 1)
{
_psi[n] = bbc_value;
_p[n] = Pf(_psi[n]);
}
}
// get soil water variables and their derivatives
for (int i = 0; i <= n; i++)
Watvar(i, _p[i], out _psi[i], out psip[i], out psipp[i], out th[i], ref thp[i], out hk[i], ref hkp[i]);
// check boundary potls
if (itbc == 0 && isbc == 0 && _psi[0] > 0.0)
{
// infinite conductance and no ponding allowed
_psi[0] = 0.0;
_p[0] = Pf(_psi[0]);
Watvar(0, _p[0], out v1, out psip[0], out psipp[0], out th[0], ref thp[0], out hk[0], ref hkp[0]);
}
if (ibbc == 3 && _psi[n] > bbc_value)
{
// seepage at bottom boundary
_psi[n] = bbc_value;
_p[n] = Pf(_psi[n]);
Watvar(n, _p[n], out v1, out psip[n], out psipp[n], out th[n], ref thp[n], out hk[n], ref hkp[n]);
}
// get fluxes between nodes
double absgf = Math.Abs(gf);
double w1, w2;
double deltap;
double deltax;
double skd;
double hkdp1;
double hkdp2;
double hsoil;
for (int i = 1; i <= n; i++)
{
if (!MathUtilities.FloatsAreEqual(x[i - 1], x[i]))
{
deltax = x[i] - x[i - 1];
deltap = _p[i] - _p[i - 1];
double hkd1 = hk[i - 1] * psip[i - 1];
double hkd2 = hk[i] * psip[i];
hkdp1 = hk[i - 1] * psipp[i - 1] + hkp[i - 1] * psip[i - 1];
hkdp2 = hk[i] * psipp[i] + hkp[i] * psip[i];
skd = hkd1 + hkd2;
if (swt >= 0.5 && swt <= 1.0)
{
// use fixed space weighting on gravity flow
w1 = MathUtilities.Sign(2.0 * swt, gf);
}
else
{
// use central diffs for gravity flow if possible, else use
// just enough upstream weighting to avoid instability
// user may increase acceptable level for central diffs
// by setting p%swt < -1
double accept = Math.Max(1.0, -swt);
double wt = 0.0;
// if(absgf.ne.0..and.hkp(i).ne.0.)then
double gfhkp = gf * hkp[i];
if (gfhkp != 0.0)
{
if (it == 1)
{
// value=1.-accept*(skd+(g%p(i)-g%p(i-1))*hkdp2)/(absgf*deltax*hkp(i))
double value = 1.0 - accept * (skd) / (Math.Abs(gfhkp) * deltax);
// value=min(1d0,value)
swta[i] = MathUtilities.Sign(Math.Max(0.0, value), gfhkp);
}
wt = swta[i];
}
w1 = 1.0 + wt;
}
w2 = 2.0 - w1;
if ((w1 > 2.0) || (w1 < 0.0))
IssueWarning("bad space weighting factor");
q[i] = -0.5 * (skd * deltap / deltax - gf * (w1 * hk[i - 1] + w2 * hk[i]));
qp1[i] = -0.5 * ((hkdp1 * deltap - skd) / deltax - gf * w1 * hkp[i - 1]);
qp2[i] = -0.5 * ((hkdp2 * deltap + skd) / deltax - gf * w2 * hkp[i]);
_swf[i] = w1;
}
}
// get fluxes to storage
for (int i = 0; i <= n; i++)
{
qs[i] = (th[i] - thold[i]) * dx[i] / _dt;
qsp[i] = thp[i] * dx[i] / _dt;
}
// get uptake fluxes to roots if still in iterations
if (iroots < 2)
{
for (int i = 0; i <= n; i++)
{
psios[i] = _psi[i];
for (int solnum = 0; solnum < num_solutes; solnum++)
psios[i] = psios[i] - tslos[solnum] * tcsl[solnum][i];
}
Uptake(ref psios, ref hk, ref psip, ref hkp, ref qex, ref qexp);
}
rex = 0.0;
for (int i = 0; i <= n; i++)
rex = rex + qex[i];
// NIH get subsurface fluxes
Drain(out qdrain, out qdrainpsi);
rssf = 0.0;
for (int i = 0; i <= n; i++)
{
qssif[i] = SubSurfaceInFlow[i] / 10.0 / 24.0; // assumes mm and daily timestep - need something better !!!!
qssof[i] = qdrain[i]; // Add outflow calc here later
qssofp[i] = qdrainpsi[i] * psip[i];
rssf += qssif[i] - qssof[i];
}
// get soil surface fluxes, taking account of top boundary condition
//
double respsi;
double roffd;
if (itbc == 0)
{
// infinite conductance
ifirst = 0;
if (_psi[0] < 0.0)
{
hsoil = Math.Max(hair, Math.Exp(hcon * _psi[0]));
res = resp * (hsoil - hair) / (1.0 - hair);
respsi = resp * hcon * hsoil / (1.0 - hair);
}
else
{
res = resp;
respsi = 0.0;
}
if (isbc == 0)
{
// no ponding allowed
_h = 0.0;
double q0 = ron - res + hold / _dt;
if (_psi[0] < 0.0 || q0 < qs[0] + qex[0] + q[1] - qssif[0] + qssof[0])
{
q[0] = q0;
qp2[0] = -respsi * psip[0];
roff = 0.0;
roffd = 0.0;
}
else
{
// const zero potl
ifirst = 1;
q[0] = qs[0] + qex[0] + q[1] - qssif[0] + qssof[0];
roff = q0 - q[0];
roffd = -qp2[1];
}
}
else
{
// runoff zero or given by a function
if (_psi[0] < 0.0)
{
_h = 0.0;
roff = 0.0;
q[0] = ron - res + hold / _dt;
qp2[0] = -respsi * psip[0];
}
else
{
_h = _psi[0];
roff = 0.0;
roffd = 0.0;
if (isbc == 2)
Runoff(t, _h, out roff, out roffd);
q[0] = ron - roff - res - (_h - hold) / _dt;
qp2[0] = (-roffd - respsi - 1.0 / _dt) * psip[0];
}
}
}
if (itbc == 1)
{
// const potl
ifirst = 1;
if (_psi[0] < 0.0)
{
hsoil = Math.Exp(hcon * _psi[0]);
res = resp * (hsoil - hair) / (1.0 - hair);
}
else
{
res = resp;
}
_h = Math.Max(_psi[0], 0.0);
q[0] = qs[0] + qex[0] + q[1] - qssif[0] + qssof[0];
// flow to source of potl treated as "runoff" (but no bypass flow)
roff = ron - res - (_h - hold) / _dt - q[0];
}
else if (itbc == 2)
{
// conductance given by a function
double g_, gh;
double q0 = ron - resp + hold / _dt;
if (isbc == 0)
{
// no ponding allowed
ifirst = 0;
_h = 0.0;
SCond(t, _h, out g_, out gh);
if (q0 > -g_ * _psi[0])
{
res = resp;
respsi = 0.0;
q[0] = -g_ * _psi[0];
qp2[0] = -g_ * psip[0];
roff = q0 - q[0];
roffd = -qp2[0];
}
else
{
hsoil = Math.Exp(hcon * _psi[0]);
res = resp * (hsoil - hair) / (1.0 - hair);
respsi = resp * hcon * hsoil / (1.0 - hair);
q0 = ron - res + hold / _dt;
q[0] = q0;
qp2[0] = -respsi * psip[0];
roff = 0.0;
}
}
else
{
// runoff zero or given by a function
SCond(t, _h, out g_, out gh);
if (q0 > -g_ * _psi[0])
{
// initialise _h if necessary
if (ifirst == 0)
_h = Math.Max(_psi[0], 0.0);
ifirst = -1;
res = resp;
roff = 0.0;
roffd = 0.0;
if (isbc == 2 && _h > 0.0)
Runoff(t, _h, out roff, out roffd);
q[0] = g_ * (_h - _psi[0]);
qp1[0] = g_ + gh * (_h - _psi[0]);
qp2[0] = -g_ * psip[0];
// WE MAY NEED TO HANDLE THE -1 INDICES SOMEHOW (though I'm not sure they are ever used)
pondingData.rhs = -(ron - roff - res - q[0] - (_h - hold) / _dt);
pondingData.b = -roffd - qp1[0] - 1.0 / _dt;
pondingData.c = -qp2[0];
//rhs[-1] = -(ron - roff - res - q[0] - (_h - hold) / _dt);
//b[-1] = -roffd - qp1[0] - 1.0 / _dt;
//c[-1] = -qp2[0];
}
else
{
ifirst = 0;
_h = 0.0;
roff = 0.0;
hsoil = Math.Exp(hcon * _psi[0]);
res = resp * (hsoil - hair) / (1.0 - hair);
respsi = resp * hcon * hsoil / (1.0 - hair);
q[0] = ron - res + hold / _dt;
qp2[0] = -respsi * psip[0];
}
}
}
// bypass flow?
qbp = 0.0;
//qbpd = 0.0;
//double qbpp = 0.0;
//double qbps = 0.0;
//double qbpsp = 0.0;
// bottom boundary condition
if (ibbc == 0)
{
// zero matric potl gradient
q[n + 1] = (gf + gr) * hk[n];
qp1[n + 1] = (gf + gr) * hkp[n];
}
else if (ibbc == 1)
{
// const potl
ilast = n - 1;
q[n + 1] = q[n] - qs[n] - qex[n] + qssif[n] - qssof[n];
}
else if (ibbc == 2)
{
// zero flux
q[n + 1] = 0.0;
qp1[n + 1] = 0.0;
}
else if (ibbc == 3)
{
// seepage
//nh added to allow seepage to user potential at bbc
if (_psi[n] >= bbc_value)
{
q[n + 1] = q[n] - qs[n] - qex[n] + qssif[n] - qssof[n];
if (q[n + 1] >= 0.0)
{
ilast = n - 1;
//qbpd = 0.0;
}
else
{
ilast = n;
}
}
if (ilast == n)
{
q[n + 1] = 0.0;
qp1[n + 1] = 0.0;
}
}
else if (ibbc == 4)
{
// flux calculated according to head difference from water table
double headdiff = _psi[n] - x[n] + bbc_value / 10.0;
q[n + 1] = headdiff * water_table_conductance;
qp1[n + 1] = psip[n] * water_table_conductance;
}
// get Newton-Raphson equations
int i1 = Math.Max(ifirst, 0);
int k = i1 - 1;
bool xidif = true;
for (int i = i1; i <= ilast; i++)
{
// allow for two nodes at same depth
bool xipdif = true;
if (xidif)
{
k = k + 1;
int j = i + 1;
// j is next different node, k is equation
if (i > 0 && i < n - 1)
{
if (MathUtilities.FloatsAreEqual(x[i], x[i + 1]))
{
xipdif = false;
j = i + 2;
q[i + 1] = ((x[j] - x[i]) * q[i] + (x[i] - x[i - 1]) * q[j]) / (x[j] - x[i - 1]);
}
}
rhs[k] = -(q[i] - q[j]);
a[k] = qp1[i];
b[k] = qp2[i] - qp1[j];
c[k] = -qp2[j];
}
rhs[k] = rhs[k] + qs[i] + qex[i] - qssif[i] + qssof[i];
b[k] = b[k] - qsp[i] - qssofp[i];
if (iroots == 0)
{
// a(k)=a(k)-qexp(1,i)
b[k] = b[k] - qexp[1, i];
// c(k)=c(k)-qexp(3,i)
}
else
{
iroots = 2;
}
xidif = xipdif;
}
ibegin = ifirst;
iend = k;
}