/// <summary> /// Solves the equation of continuity from time ts to tfin. /// </summary> /// <param name="sol">solute properties.</param> /// <param name="sdata">soil data.</param> /// <param name="ts">start time (h).</param> /// <param name="tfin">finish time.</param> /// <param name="qprec">precipitation (or water input) rate (fluxes are in cm/h).</param> /// <param name="qevap">potl evaporation rate from soil surface.</param> /// <param name="nsol">no. of solutes.</param> /// <param name="nex">no. of water extraction streams.</param> /// <param name="h0">surface head, equal to depth of surface pond.</param> /// <param name="S">degree of saturation ("effective satn") of layers.</param> /// <param name="evap">cumulative evaporation from soil surface (cm, not initialised).</param> /// <param name="runoff">cumulative runoff.</param> /// <param name="infil">cumulative net infiltration (time integral of flux across surface).</param> /// <param name="drn">cumulative net drainage (time integral of flux across bottom).</param> /// <param name="nsteps">cumulative no. of time steps for RE soln.</param> /// <param name="jt">layer soil type numbers for solute.</param> /// <param name="cin">solute concns in water input (user's units/cc).</param> /// <param name="c0">solute concns in surface pond.</param> /// <param name="sm">solute (mass) concns in layers.</param> /// <param name="soff">cumulative solute runoff (user's units).</param> /// <param name="sinfil">cumulative solute infiltration.</param> /// <param name="sdrn">cumulative solute drainage.</param> /// <param name="nssteps">cumulative no. of time steps for ADE soln.</param> /// <param name="wex">cumulative water extractions from layers.</param> /// <param name="sex">cumulative solute extractions from layers.</param> public static void Solve(SolProps sol, SoilData sdata, double ts, double tfin, double qprec, double qevap, int nsol, int nex, ref double h0, ref double[] S, ref double evap, ref double runoff, ref double infil, ref double drn, ref int nsteps, int[] jt, double[] cin, ref double[] c0, ref double[,] sm, ref double[] soff, ref double[] sinfil, ref double[] sdrn, ref int[] nssteps, ref double[,] wex, ref double[,,] sex) { // Since S.Length is one greater in Fortran to account for the 0 based index, this line is included // so that the +1 nomenclature can be kept below to avoid (further) confusion. int sLength = S.Length - 1; bool again, extraction, initpond, maxpond; int i, iflux, ih0, iok, isatbot, itmp, ns, nsat, nsatlast, nsteps0; int[] isat = new int[sLength + 1]; double accel, dmax, dt, dwinfil, dwoff, fac, infili, qpme, qprec1, rsig, rsigdt, sig, t, ti, win, xtblbot; double[] dSdt = new double[sLength + 1]; double[] h = new double[sLength + 1]; double[] xtbl = new double[sLength + 1]; double[] thi = new double[sLength + 1]; double[] thf = new double[sLength + 1]; double[] qwex = new double[sLength + 1]; double[] qwexd = new double[sLength + 1]; double[,] dwexs = new double[sLength + 1, nex + 1]; double[,] qwexs = new double[sLength + 1, nex + 1]; double[,] qwexsd = new double[sLength + 1, nex + 1]; double[] aa = new double[sLength+1]; // these are 0 based double[] bb = new double[sLength+1]; double[] cc = new double[sLength + 1]; double[] dd = new double[sLength + 1]; double[] dy = new double[sLength + 1]; double[] ee = new double[sLength + 1]; double[] q = new double[sLength + 1]; double[] qya = new double[sLength + 1]; double[] qyb = new double[sLength + 1]; double[] cav = new double[nsol + 1]; double[] sinfili = new double[nsol + 1]; double[,] c; sd = sdata; c = new double[nsol + 1, sd.n + 1]; ISink sink = new SinkDripperDrain(); // Sink type can be changed here. /* ! The saturation status of a layer is stored as 0 or 1 in isat since S may be ! >1 (because of previous overshoot) when a layer desaturates. Fluxes at the ! beginning of a time step and their partial derivs wrt S or h of upper and ! lower layers or boundaries are stored in q, qya and qyb. */ isatbot = 0; xtblbot = 0; dt = 0.0; fac = 0.0; initpond = false; extraction = false; dwoff = 0.0; ti = 0.0; infili = 0.0; if (nex > 0) extraction = true; if (sLength != sd.n) { Console.WriteLine("solve: Size of S differs from table data."); Environment.Exit(1); } //-----set up for boundary conditions if (botbc == "constant head") // !h at bottom bdry specified if (hbot < sd.he[sd.n]) { isatbot = 0; xtblbot = Sbot; } else { isatbot = 1; xtblbot = hbot - sd.he[sd.n]; } //-----end set up for boundary conditions //-----initialise t = ts; nsteps0 = nsteps; nsat = 0; //initialise saturated regions for (int x = 1; x < sLength; x++) if (S[x] >= 1.0) { isat[x] = 1; h[x] = sd.he[x]; } else { isat[x] = 0; h[x] = sd.he[x] - 1.0; } if (nsol > 0) { //set solute info thi = MathUtilities.Multiply(sd.ths, S); //initial th dwexs.Populate2D(0); //initial water extracted from layers ti = t; infili = infil; sinfili = sinfil; double c0Temp = c0[1]; if (h0 > 0 && cin.Any(x => x != c0Temp)) // count(c0 /= cin) > 0) initpond = true; //initial pond with different solute concn else initpond = false; c.Populate2D(0); //temp storage for soln concns } //-----end initialise //-----solve until tfin while (t < tfin) { //-----take next time step for (iflux = 1; iflux <= 2; iflux++) //sometimes need twice to adjust h at satn { nsatlast = nsat; // for detecting onset of profile saturation nsat = isat.Sum(); sig = 0.5; if (nsat != 0) sig = 1.0; //time weighting sigma rsig = 1.0 / sig; //-----get fluxes and derivs // get table entries for (int x = 1; x < isat.Length; x++) if (isat[x] == 0) xtbl[x] = S[x]; else xtbl[x] = h[x] - sd.he[x]; //get surface flux qpme = qprec - qevap; //input rate at saturation qprec1 = qprec; //may change qprec1 to maintain pond if required if (h[1] <= 0 && h0 <= 0 && nsat < sd.n) //no ponding { ns = 1; //start index for eqns sd.GetQ(0, new [] {0, 0, isat[1] }, new [] {0, 0, xtbl[1] }, out q[0], out qya[0], out qyb[0]); if (q[0] < qpme) { q[0] = qpme; qyb[0] = 0; } maxpond = false; } else //ponding { ns = 0; sd.GetQ(0, new [] {0, 1, isat[1] }, new [] {0, h0 - sd.he[1], xtbl[1] }, out q[0], out qya[0], out qyb[0]); if (h0 >= h0max && qpme > q[0]) { maxpond = true; ns = 1; } else maxpond = false; } //get profile fluxes for (i = 1; i <= sd.n - 1; i++) sd.GetQ(i, new [] {0, isat[i], isat[i + 1] }, new [] {0, xtbl[i], xtbl[i + 1] }, out q[i], out qya[i], out qyb[i]); //get bottom flux switch (botbc) { case "constant head": sd.GetQ(sd.n, new [] {0, isat[sd.n], isatbot }, new [] {0, xtbl[sd.n], xtblbot }, out q[sd.n], out qya[sd.n], out qyb[sd.n]); break; case "0.0 flux": q[sd.n] = 0; qya[sd.n] = 0; break; case "free drainage": sd.GetK(sd.n, isat[sd.n], xtbl[sd.n], out q[sd.n], out qya[sd.n]); break; case "seepage": if (h[sd.n] <= -0.5 * sd.dx[sd.n]) { q[sd.n] = 0; qya[sd.n] = 0; } else sd.GetQ(sd.n, new int[] {0, isat[sd.n], 1 }, new double[] {0, xtbl[sd.n], -sd.he[sd.n] }, out q[sd.n], out qya[sd.n], out qyb[sd.n]); break; default: Console.Out.WriteLine("solve: illegal bottom boundary condn"); Environment.Exit(1); break; } if (extraction) //get rate of extraction { sink.Wsinks(t, isat, xtbl, sd.he, ref qwexs, ref qwexsd); for (int x = 1; x < qwexs.GetLength(1); x++) { qwex[x] = Matrix<double>.Build.DenseOfArray(qwexs).Column(x).Sum(); qwexd[x] = Matrix<double>.Build.DenseOfArray(qwexsd).Column(x).Sum(); } } again = false; //flag for recalcn of fluxes //-----end get fluxes and derivs //----estimate time step dt dmax = 0; dSdt = MathUtilities.CreateArrayOfValues(0, dSdt.Length); for (int x = 1; x <= sd.n; x++) { if (isat[x] == 0) dSdt[x] = Math.Abs(q[x] - q[x - 1] + (extraction ? qwex[x] : 0)) / (sd.ths[x] * sd.dx[x]); } dmax = MathUtilities.Max(dSdt); //Max derivative | dS / dt | if (dmax > 0) { dt = dSmax / dmax; // if pond going adjust dt if (h0 > 0 && (q[0] - qpme) * dt > h0) dt = (h0 - 0.5 * h0min) / (q[0] - qpme); } else //steady state flow { if (qpme >= q[sd.n]) //step to finish -but what if extraction varies with time ??? dt = tfin - t; else dt = -(h0 - 0.5 * h0min) / (qpme - q[sd.n]); //pond going so adjust dt } if (dt > dtmax) dt = dtmax; //user's limit // if initial step, improve h where S>= 1 if (nsteps == nsteps0 && nsat > 0 && iflux == 1) { again = true; dt = 1.0e-20 * (tfin - ts); } if (nsat == sd.n && nsatlast < sd.n && iflux == 1) { //profile has just become saturated so adjust h values again = true; dt = 1.0e-20 * (tfin - ts); } if (t + 1.1 * dt > tfin) //step to finish { dt = tfin - t; t = tfin; } else t = t + dt; //tentative update //-----end estimate time step dt //-----get and solve eqns rsigdt = 1.0 / (sig * dt); //aa, bb, cc and dd hold coeffs and rhs of tridiag eqn set for (int x = ns; x <= sd.n - 1; x++) { aa[x + 1] = qya[x]; cc[x] = -qyb[x]; } if (extraction) for (int x = 1; x <= sd.n; x++) dd[x] = -(q[x - 1] - q[x] - qwex[x]) * rsig; else for (int x = 1; x <= sd.n; x++) dd[x] = -(q[x - 1] - q[x]) * rsig; iok = 0; //flag for time step test itmp = 0; //counter to abort if not getting solution while (iok == 0) //keep reducing time step until all ok { itmp = itmp + 1; accel = 1.0 - 0.05 * Math.Min(10, Math.Max(0, itmp - 4)); //acceleration if (itmp > 20) { Console.Out.WriteLine("solve: too many iterations of equation solution"); Environment.Exit(1); } if (ns < 1) { bb[0] = -qya[0] - rsigdt; dd[0] = -(qpme - q[0]) * rsig; } for (int x = 1; x <= sd.n; x++) { bb[x] = qyb[x - 1] - qya[x]; if (isat[x]==0) bb[x] -= sd.ths[x] * sd.dx[x] * rsigdt; if (extraction) bb[x] -= qwexd[x]; } Tri(ns, sd.n, aa, ref bb, cc, dd, ref ee, ref dy); //dy contains dS or, for sat layers, h values iok = 1; if (!again) { //check if time step ok, if not then set fac to make it less iok = 1; for (i = 1; i <= sd.n; i++) { if (isat[i] == 0) //check change in S { if (Math.Abs(dy[i]) > dSfac * dSmax) { fac = Math.Max(0.5, accel * Math.Abs(dSmax / dy[i])); iok = 0; break; } if (-dy[i] > dSmaxr * S[i]) { fac = Math.Max(0.5, accel * dSmaxr * S[i] / (-dSfac * dy[i])); iok = 0; break; } if (S[i] < 1.0 && S[i] + dy[i] > Smax) { fac = accel * (0.5 * (1.0 + Smax) - S[i]) / dy[i]; iok = 0; break; } if (S[i] >= 1.0 && dy[i] > 0.5 * (Smax - 1.0)) { fac = 0.25 * (Smax - 1.0) / dy[i]; iok = 0; break; } } } if (iok == 1 && ns < 1 && h0 < h0max && h0 + dy[0] > h0max + dh0max) { //start of runoff fac = (h0max + 0.5 * dh0max - h0) / dy[0]; iok = 0; } if (iok == 1 && ns < 1 && h0 > 0.0 && h0 + dy[0] < h0min) { //pond going fac = -(h0 - 0.5 * h0min) / dy[0]; iok = 0; } if (iok == 0) //reduce time step { t = t - dt; dt = fac * dt; t = t + dt; rsigdt = 1.0 / (sig * dt); nless = nless + 1; //count step size reductions } if (isat[1] != 0 && iflux == 1 && h[1] < 0.0 && h[1] + dy[1] > 0.0) { //incipient ponding - adjust state of saturated regions t = t - dt; dt = 1.0e-20 * (tfin - ts); rsigdt = 1.0 / (sig * dt); again = true; iok = 0; } } } //end while //-----end get and solve eqns //-----update unknowns ih0 = 0; if (!again) { dwoff = 0.0; if (ns < 1) { h0 = h0 + dy[0]; if (h0 < 0.0 && dy[0] < 0.0) ih0 = 1; //pond g1.0 evap = evap + qevap * dt; //note that fluxes required are q at sigma of time step dwinfil = (q[0] + sig * (qya[0] * dy[0] + qyb[0] * dy[1])) * dt; } else { dwinfil = (q[0] + sig * qyb[0] * dy[1]) * dt; if (maxpond) { evap = evap + qevap * dt; if (qprec > qprecmax) // set input to maintain pond { qpme = q[0] + sig * qyb[0] * dy[1]; qprec1 = qpme + qevap; dwoff = 0.0; } else { dwoff = qpme * dt - dwinfil; } runoff = runoff + dwoff; } else evap = evap + qprec1 * dt - dwinfil; } infil = infil + dwinfil; if (nsol > 0) //get surface solute balance { if (initpond) //pond concn != cin { if (h0 > 0.0) { if (ns == 1) // if max pond depth dy[0] = 0.0; for (int x = 1; x < cav.Length; x++) cav[x] = ((2.0 * h0 - dy[0]) * c0[x] + qprec1 * dt * cin[x]) / (2.0 * h0 + dwoff + dwinfil); for (int x = 1; x < c0.Length; x++) c0[x] = 2.0 * cav[x] - c0[x]; //This needs to be tested from FORTRAN; no example in original code. } else { for (int x = 1; x < cav.Length; x++) cav[x] = ((h0 - dy[0]) * c0[x] + qprec1 * dt * cin[x]) / (dwoff + dwinfil); initpond = false; //pond gone c0 = cin; // for output if any pond at end } soff = MathUtilities.Add(soff, MathUtilities.Multiply_Value(cav, dwoff)); sinfil = MathUtilities.Add(sinfil, MathUtilities.Multiply_Value(cav, dwinfil)); } else { soff = MathUtilities.Add(soff, MathUtilities.Multiply_Value(cav, dwoff)); sinfil = MathUtilities.Add(sinfil, MathUtilities.Multiply_Value(cin, qprec1 * dt - dwoff)); } } // There's a condition based on botbc in the FORTRAN here, but both paths // resolve to the same equation. drn = drn + (q[sd.n] + sig * qya[sd.n] * dy[sd.n]) * dt; if (extraction) { Matrix<double> dwexsM = Matrix<double>.Build.DenseOfArray(dwexs); Matrix<double> qwexsM = Matrix<double>.Build.DenseOfArray(qwexs); Matrix<double> qwexsdM = Matrix<double>.Build.DenseOfArray(qwexsd); Matrix<double> wexM = Matrix<double>.Build.DenseOfArray(wex); Vector<double> wexV; Vector<double> dwexsV; Vector<double> qwexsV; Vector<double> qwexsdV; if (nsol > 0) { //dwexs = dwexs + (qwexs + sig * qwexsd * spread(dy(1:n), 2, nex)) * dt for (i = 1; i <= nex; i++) { dwexsV = dwexsM.Column(i); qwexsV = qwexsM.Column(i); qwexsdV = qwexsdM.Column(i); dwexsV = dwexsV + (qwexsV + sig * qwexsdV * Vector<double>.Build.DenseOfArray(dy.Slice(1, sd.n))) * dt; dwexsM.Column(i, dwexsV); } dwexs = dwexsM.ToArray(); } //wex = wex + (qwexs + sig * qwexsd * spread(dy(1:n), 2, nex)) * dt if (wex.GetLength(0) > 1) // analog for if (present(wex)) { for (i = 1; i <= nex; i++) { qwexsV = qwexsM.Column(i); qwexsdV = qwexsdM.Column(i); wexV = wexM.Column(i); wexV = wexV + (qwexsV + sig * qwexsdV * Vector<double>.Build.DenseOfArray(dy.Slice(1, sd.n))) * dt; wexM.Column(i, wexV); } wex = wexM.ToArray(); } } } for (i = 1; i <= sd.n; i++) { if (isat[i] == 0) { if (!again) { S[i] = S[i] + dy[i]; if (S[i] > 1.0 && dy[i] > 0.0) //saturation of layer { isat[i] = 1; h[i] = sd.he[i]; } } } else { h[i] = h[i] + dy[i]; if (i == 1 && ih0 != 0 && h[i] >= sd.he[i]) h[i] = sd.he[i] - 1.0; //pond gone if (h[i] < sd.he[i]) //desaturation of layer { isat[i] = 0; h[i] = sd.he[i]; } } } //-----end update unknowns if (!again) break; } if (dt <= dtmin) { Console.WriteLine("solve: time step = " + dt); Environment.Exit(1); } //-----end take next time step //remove negative h0 (optional) if (h0 < 0.0 && isat[1] == 0) { infil = infil + h0; S[1] = S[1] + h0 / (sd.ths[1] * sd.dx[1]); h0 = 0.0; } nsteps = nsteps + 1; //solve for solute transport if required if (nwsteps * (nsteps / nwsteps) == nsteps) { // This is function getsolute() in FORTRAN. Inline here as it uses a huge number of vars and is only used once. if (nsol > 0 && t > ti) { thf = MathUtilities.Multiply(sd.ths, S); //final th before call win = infil - infili; //water in at top over time interval cav = MathUtilities.Divide_Value(MathUtilities.Subtract(sinfil, sinfili), win); //average concn in win Solute(ti, t, thi, thf, dwexs, win, cav, sd.n, nsol, nex, sd.dx, jt, dsmmax, ref sm, ref sdrn, ref nssteps, ref c, ref sex, extraction, sol); ti = t; thi = thf; dwexs.Populate2D(0); infili = infil; sinfili = sinfil; // for next interval } } } //-----end solve until tfin //finalise solute transport if required }
/// <summary> /// Solves the equation of continuity from time ts to tfin. /// </summary> /// <param name="sol">solute properties.</param> /// <param name="sdata">soil data.</param> /// <param name="ts">start time (h).</param> /// <param name="tfin">finish time.</param> /// <param name="qprec">precipitation (or water input) rate (fluxes are in cm/h).</param> /// <param name="qevap">potl evaporation rate from soil surface.</param> /// <param name="nsol">no. of solutes.</param> /// <param name="nex">no. of water extraction streams.</param> /// <param name="h0">surface head, equal to depth of surface pond.</param> /// <param name="S">degree of saturation ("effective satn") of layers.</param> /// <param name="evap">cumulative evaporation from soil surface (cm, not initialised).</param> /// <param name="runoff">cumulative runoff.</param> /// <param name="infil">cumulative net infiltration (time integral of flux across surface).</param> /// <param name="drn">cumulative net drainage (time integral of flux across bottom).</param> /// <param name="nsteps">cumulative no. of time steps for RE soln.</param> /// <param name="jt">layer soil type numbers for solute.</param> /// <param name="cin">solute concns in water input (user's units/cc).</param> /// <param name="c0">solute concns in surface pond.</param> /// <param name="sm">solute (mass) concns in layers.</param> /// <param name="soff">cumulative solute runoff (user's units).</param> /// <param name="sinfil">cumulative solute infiltration.</param> /// <param name="sdrn">cumulative solute drainage.</param> /// <param name="nssteps">cumulative no. of time steps for ADE soln.</param> /// <param name="wex">cumulative water extractions from layers.</param> /// <param name="sex">cumulative solute extractions from layers.</param> public static void Solve(SolProps sol, SoilData sdata, double ts, double tfin, double qprec, double qevap, int nsol, int nex, ref double h0, ref double[] S, ref double evap, ref double runoff, ref double infil, ref double drn, ref int nsteps, int[] jt, double[] cin, ref double[] c0, ref double[,] sm, ref double[] soff, ref double[] sinfil, ref double[] sdrn, ref int[] nssteps, ref double[,] wex, ref double[,,] sex) { // Since S.Length is one greater in Fortran to account for the 0 based index, this line is included // so that the +1 nomenclature can be kept below to avoid (further) confusion. int sLength = S.Length - 1; bool again, extraction, initpond, maxpond; int i, iflux, ih0, iok, isatbot, itmp, ns, nsat, nsatlast, nsteps0; int[] isat = new int[sLength + 1]; double accel, dmax, dt, dwinfil, dwoff, fac, infili, qpme, qprec1, rsig, rsigdt, sig, t, ti, win, xtblbot; double[] dSdt = new double[sLength + 1]; double[] h = new double[sLength + 1]; double[] xtbl = new double[sLength + 1]; double[] thi = new double[sLength + 1]; double[] thf = new double[sLength + 1]; double[] qwex = new double[sLength + 1]; double[] qwexd = new double[sLength + 1]; double[,] dwexs = new double[sLength + 1, nex + 1]; double[,] qwexs = new double[sLength + 1, nex + 1]; double[,] qwexsd = new double[sLength + 1, nex + 1]; double[] aa = new double[sLength + 1]; // these are 0 based double[] bb = new double[sLength + 1]; double[] cc = new double[sLength + 1]; double[] dd = new double[sLength + 1]; double[] dy = new double[sLength + 1]; double[] ee = new double[sLength + 1]; double[] q = new double[sLength + 1]; double[] qya = new double[sLength + 1]; double[] qyb = new double[sLength + 1]; double[] cav = new double[nsol + 1]; double[] sinfili = new double[nsol + 1]; double[,] c; sd = sdata; c = new double[nsol + 1, sd.n + 1]; ISink sink = new SinkDripperDrain(); // Sink type can be changed here. /* * ! The saturation status of a layer is stored as 0 or 1 in isat since S may be * ! >1 (because of previous overshoot) when a layer desaturates. Fluxes at the * ! beginning of a time step and their partial derivs wrt S or h of upper and * ! lower layers or boundaries are stored in q, qya and qyb. */ isatbot = 0; xtblbot = 0; dt = 0.0; fac = 0.0; initpond = false; extraction = false; dwoff = 0.0; ti = 0.0; infili = 0.0; if (nex > 0) { extraction = true; } if (sLength != sd.n) { Console.WriteLine("solve: Size of S differs from table data."); Environment.Exit(1); } //-----set up for boundary conditions if (botbc == "constant head") // !h at bottom bdry specified { if (hbot < sd.he[sd.n]) { isatbot = 0; xtblbot = Sbot; } else { isatbot = 1; xtblbot = hbot - sd.he[sd.n]; } } //-----end set up for boundary conditions //-----initialise t = ts; nsteps0 = nsteps; nsat = 0; //initialise saturated regions for (int x = 1; x < sLength; x++) { if (S[x] >= 1.0) { isat[x] = 1; h[x] = sd.he[x]; } else { isat[x] = 0; h[x] = sd.he[x] - 1.0; } } if (nsol > 0) { //set solute info thi = MathUtilities.Multiply(sd.ths, S); //initial th dwexs.Populate2D(0); //initial water extracted from layers ti = t; infili = infil; sinfili = sinfil; double c0Temp = c0[1]; if (h0 > 0 && cin.Any(x => x != c0Temp)) // count(c0 /= cin) > 0) { initpond = true; //initial pond with different solute concn } else { initpond = false; } c.Populate2D(0); //temp storage for soln concns } //-----end initialise //-----solve until tfin while (t < tfin) { //-----take next time step for (iflux = 1; iflux <= 2; iflux++) //sometimes need twice to adjust h at satn { nsatlast = nsat; // for detecting onset of profile saturation nsat = isat.Sum(); sig = 0.5; if (nsat != 0) { sig = 1.0; //time weighting sigma } rsig = 1.0 / sig; //-----get fluxes and derivs // get table entries for (int x = 1; x < isat.Length; x++) { if (isat[x] == 0) { xtbl[x] = S[x]; } else { xtbl[x] = h[x] - sd.he[x]; } } //get surface flux qpme = qprec - qevap; //input rate at saturation qprec1 = qprec; //may change qprec1 to maintain pond if required if (h[1] <= 0 && h0 <= 0 && nsat < sd.n) //no ponding { ns = 1; //start index for eqns sd.GetQ(0, new [] { 0, 0, isat[1] }, new [] { 0, 0, xtbl[1] }, out q[0], out qya[0], out qyb[0]); if (q[0] < qpme) { q[0] = qpme; qyb[0] = 0; } maxpond = false; } else //ponding { ns = 0; sd.GetQ(0, new [] { 0, 1, isat[1] }, new [] { 0, h0 - sd.he[1], xtbl[1] }, out q[0], out qya[0], out qyb[0]); if (h0 >= h0max && qpme > q[0]) { maxpond = true; ns = 1; } else { maxpond = false; } } //get profile fluxes for (i = 1; i <= sd.n - 1; i++) { sd.GetQ(i, new [] { 0, isat[i], isat[i + 1] }, new [] { 0, xtbl[i], xtbl[i + 1] }, out q[i], out qya[i], out qyb[i]); } //get bottom flux switch (botbc) { case "constant head": sd.GetQ(sd.n, new [] { 0, isat[sd.n], isatbot }, new [] { 0, xtbl[sd.n], xtblbot }, out q[sd.n], out qya[sd.n], out qyb[sd.n]); break; case "0.0 flux": q[sd.n] = 0; qya[sd.n] = 0; break; case "free drainage": sd.GetK(sd.n, isat[sd.n], xtbl[sd.n], out q[sd.n], out qya[sd.n]); break; case "seepage": if (h[sd.n] <= -0.5 * sd.dx[sd.n]) { q[sd.n] = 0; qya[sd.n] = 0; } else { sd.GetQ(sd.n, new int[] { 0, isat[sd.n], 1 }, new double[] { 0, xtbl[sd.n], -sd.he[sd.n] }, out q[sd.n], out qya[sd.n], out qyb[sd.n]); } break; default: Console.Out.WriteLine("solve: illegal bottom boundary condn"); Environment.Exit(1); break; } if (extraction) //get rate of extraction { sink.Wsinks(t, isat, xtbl, sd.he, ref qwexs, ref qwexsd); for (int x = 1; x < qwexs.GetLength(1); x++) { qwex[x] = Matrix <double> .Build.DenseOfArray(qwexs).Column(x).Sum(); qwexd[x] = Matrix <double> .Build.DenseOfArray(qwexsd).Column(x).Sum(); } } again = false; //flag for recalcn of fluxes //-----end get fluxes and derivs //----estimate time step dt dmax = 0; dSdt = MathUtilities.CreateArrayOfValues(0, dSdt.Length); for (int x = 1; x <= sd.n; x++) { if (isat[x] == 0) { dSdt[x] = Math.Abs(q[x] - q[x - 1] + (extraction ? qwex[x] : 0)) / (sd.ths[x] * sd.dx[x]); } } dmax = MathUtilities.Max(dSdt); //Max derivative | dS / dt | if (dmax > 0) { dt = dSmax / dmax; // if pond going adjust dt if (h0 > 0 && (q[0] - qpme) * dt > h0) { dt = (h0 - 0.5 * h0min) / (q[0] - qpme); } } else //steady state flow { if (qpme >= q[sd.n]) //step to finish -but what if extraction varies with time ??? { dt = tfin - t; } else { dt = -(h0 - 0.5 * h0min) / (qpme - q[sd.n]); //pond going so adjust dt } } if (dt > dtmax) { dt = dtmax; //user's limit } // if initial step, improve h where S>= 1 if (nsteps == nsteps0 && nsat > 0 && iflux == 1) { again = true; dt = 1.0e-20 * (tfin - ts); } if (nsat == sd.n && nsatlast < sd.n && iflux == 1) { //profile has just become saturated so adjust h values again = true; dt = 1.0e-20 * (tfin - ts); } if (t + 1.1 * dt > tfin) //step to finish { dt = tfin - t; t = tfin; } else { t = t + dt; //tentative update } //-----end estimate time step dt //-----get and solve eqns rsigdt = 1.0 / (sig * dt); //aa, bb, cc and dd hold coeffs and rhs of tridiag eqn set for (int x = ns; x <= sd.n - 1; x++) { aa[x + 1] = qya[x]; cc[x] = -qyb[x]; } if (extraction) { for (int x = 1; x <= sd.n; x++) { dd[x] = -(q[x - 1] - q[x] - qwex[x]) * rsig; } } else { for (int x = 1; x <= sd.n; x++) { dd[x] = -(q[x - 1] - q[x]) * rsig; } } iok = 0; //flag for time step test itmp = 0; //counter to abort if not getting solution while (iok == 0) //keep reducing time step until all ok { itmp = itmp + 1; accel = 1.0 - 0.05 * Math.Min(10, Math.Max(0, itmp - 4)); //acceleration if (itmp > 20) { Console.Out.WriteLine("solve: too many iterations of equation solution"); Environment.Exit(1); } if (ns < 1) { bb[0] = -qya[0] - rsigdt; dd[0] = -(qpme - q[0]) * rsig; } for (int x = 1; x <= sd.n; x++) { bb[x] = qyb[x - 1] - qya[x]; if (isat[x] == 0) { bb[x] -= sd.ths[x] * sd.dx[x] * rsigdt; } if (extraction) { bb[x] -= qwexd[x]; } } Tri(ns, sd.n, aa, ref bb, cc, dd, ref ee, ref dy); //dy contains dS or, for sat layers, h values iok = 1; if (!again) { //check if time step ok, if not then set fac to make it less iok = 1; for (i = 1; i <= sd.n; i++) { if (isat[i] == 0) //check change in S { if (Math.Abs(dy[i]) > dSfac * dSmax) { fac = Math.Max(0.5, accel * Math.Abs(dSmax / dy[i])); iok = 0; break; } if (-dy[i] > dSmaxr * S[i]) { fac = Math.Max(0.5, accel * dSmaxr * S[i] / (-dSfac * dy[i])); iok = 0; break; } if (S[i] < 1.0 && S[i] + dy[i] > Smax) { fac = accel * (0.5 * (1.0 + Smax) - S[i]) / dy[i]; iok = 0; break; } if (S[i] >= 1.0 && dy[i] > 0.5 * (Smax - 1.0)) { fac = 0.25 * (Smax - 1.0) / dy[i]; iok = 0; break; } } } if (iok == 1 && ns < 1 && h0 < h0max && h0 + dy[0] > h0max + dh0max) { //start of runoff fac = (h0max + 0.5 * dh0max - h0) / dy[0]; iok = 0; } if (iok == 1 && ns < 1 && h0 > 0.0 && h0 + dy[0] < h0min) { //pond going fac = -(h0 - 0.5 * h0min) / dy[0]; iok = 0; } if (iok == 0) //reduce time step { t = t - dt; dt = fac * dt; t = t + dt; rsigdt = 1.0 / (sig * dt); nless = nless + 1; //count step size reductions } if (isat[1] != 0 && iflux == 1 && h[1] < 0.0 && h[1] + dy[1] > 0.0) { //incipient ponding - adjust state of saturated regions t = t - dt; dt = 1.0e-20 * (tfin - ts); rsigdt = 1.0 / (sig * dt); again = true; iok = 0; } } } //end while //-----end get and solve eqns //-----update unknowns ih0 = 0; if (!again) { dwoff = 0.0; if (ns < 1) { h0 = h0 + dy[0]; if (h0 < 0.0 && dy[0] < 0.0) { ih0 = 1; //pond g1.0 } evap = evap + qevap * dt; //note that fluxes required are q at sigma of time step dwinfil = (q[0] + sig * (qya[0] * dy[0] + qyb[0] * dy[1])) * dt; } else { dwinfil = (q[0] + sig * qyb[0] * dy[1]) * dt; if (maxpond) { evap = evap + qevap * dt; if (qprec > qprecmax) // set input to maintain pond { qpme = q[0] + sig * qyb[0] * dy[1]; qprec1 = qpme + qevap; dwoff = 0.0; } else { dwoff = qpme * dt - dwinfil; } runoff = runoff + dwoff; } else { evap = evap + qprec1 * dt - dwinfil; } } infil = infil + dwinfil; if (nsol > 0) //get surface solute balance { if (initpond) //pond concn != cin { if (h0 > 0.0) { if (ns == 1) // if max pond depth { dy[0] = 0.0; } for (int x = 1; x < cav.Length; x++) { cav[x] = ((2.0 * h0 - dy[0]) * c0[x] + qprec1 * dt * cin[x]) / (2.0 * h0 + dwoff + dwinfil); } for (int x = 1; x < c0.Length; x++) { c0[x] = 2.0 * cav[x] - c0[x]; //This needs to be tested from FORTRAN; no example in original code. } } else { for (int x = 1; x < cav.Length; x++) { cav[x] = ((h0 - dy[0]) * c0[x] + qprec1 * dt * cin[x]) / (dwoff + dwinfil); } initpond = false; //pond gone c0 = cin; // for output if any pond at end } soff = MathUtilities.Add(soff, MathUtilities.Multiply_Value(cav, dwoff)); sinfil = MathUtilities.Add(sinfil, MathUtilities.Multiply_Value(cav, dwinfil)); } else { soff = MathUtilities.Add(soff, MathUtilities.Multiply_Value(cav, dwoff)); sinfil = MathUtilities.Add(sinfil, MathUtilities.Multiply_Value(cin, qprec1 * dt - dwoff)); } } // There's a condition based on botbc in the FORTRAN here, but both paths // resolve to the same equation. drn = drn + (q[sd.n] + sig * qya[sd.n] * dy[sd.n]) * dt; if (extraction) { Matrix <double> dwexsM = Matrix <double> .Build.DenseOfArray(dwexs); Matrix <double> qwexsM = Matrix <double> .Build.DenseOfArray(qwexs); Matrix <double> qwexsdM = Matrix <double> .Build.DenseOfArray(qwexsd); Matrix <double> wexM = Matrix <double> .Build.DenseOfArray(wex); Vector <double> wexV; Vector <double> dwexsV; Vector <double> qwexsV; Vector <double> qwexsdV; if (nsol > 0) { //dwexs = dwexs + (qwexs + sig * qwexsd * spread(dy(1:n), 2, nex)) * dt for (i = 1; i <= nex; i++) { dwexsV = dwexsM.Column(i); qwexsV = qwexsM.Column(i); qwexsdV = qwexsdM.Column(i); dwexsV = dwexsV + (qwexsV + sig * qwexsdV * Vector <double> .Build.DenseOfArray(dy.Slice(1, sd.n))) * dt; dwexsM.Column(i, dwexsV); } dwexs = dwexsM.ToArray(); } //wex = wex + (qwexs + sig * qwexsd * spread(dy(1:n), 2, nex)) * dt if (wex.GetLength(0) > 1) // analog for if (present(wex)) { for (i = 1; i <= nex; i++) { qwexsV = qwexsM.Column(i); qwexsdV = qwexsdM.Column(i); wexV = wexM.Column(i); wexV = wexV + (qwexsV + sig * qwexsdV * Vector <double> .Build.DenseOfArray(dy.Slice(1, sd.n))) * dt; wexM.Column(i, wexV); } wex = wexM.ToArray(); } } } for (i = 1; i <= sd.n; i++) { if (isat[i] == 0) { if (!again) { S[i] = S[i] + dy[i]; if (S[i] > 1.0 && dy[i] > 0.0) //saturation of layer { isat[i] = 1; h[i] = sd.he[i]; } } } else { h[i] = h[i] + dy[i]; if (i == 1 && ih0 != 0 && h[i] >= sd.he[i]) { h[i] = sd.he[i] - 1.0; //pond gone } if (h[i] < sd.he[i]) //desaturation of layer { isat[i] = 0; h[i] = sd.he[i]; } } } //-----end update unknowns if (!again) { break; } } if (dt <= dtmin) { Console.WriteLine("solve: time step = " + dt); Environment.Exit(1); } //-----end take next time step //remove negative h0 (optional) if (h0 < 0.0 && isat[1] == 0) { infil = infil + h0; S[1] = S[1] + h0 / (sd.ths[1] * sd.dx[1]); h0 = 0.0; } nsteps = nsteps + 1; //solve for solute transport if required if (nwsteps * (nsteps / nwsteps) == nsteps) { // This is function getsolute() in FORTRAN. Inline here as it uses a huge number of vars and is only used once. if (nsol > 0 && t > ti) { thf = MathUtilities.Multiply(sd.ths, S); //final th before call win = infil - infili; //water in at top over time interval cav = MathUtilities.Divide_Value(MathUtilities.Subtract(sinfil, sinfili), win); //average concn in win Solute(ti, t, thi, thf, dwexs, win, cav, sd.n, nsol, nex, sd.dx, jt, dsmmax, ref sm, ref sdrn, ref nssteps, ref c, ref sex, extraction, sol); ti = t; thi = thf; dwexs.Populate2D(0); infili = infil; sinfili = sinfil; // for next interval } } } //-----end solve until tfin //finalise solute transport if required }