/* Problem 1 for colnew

  Reference:
   U. Ascher, J. Christiansen and R. D. Russell,
   Collocation software for boundary-value odes,
   ACM Trans. Math Software 7 (1981), 209-222.
   doi:10.1145/355945.355950
*/

/* One differential equation of order 4 */
m : [4];

/* Location of boundary conditions */
zeta : float([1,1,2,2]);

/* Set up parameter array.  Use defaults for all except initial mesh
size, number of tolerances and sizes of work arrays */
ipar : makelist(0,k,1,11);
ipar[3] : 1;
ipar[4] : 2;
ipar[5] : 2000;
ipar[6] : 200;

/* Two error tolerances (on u and its second derivative */
ltol : [1, 3];
tol : [1d-7, 1d-7];

fspace : makelist(0d0, k, 1, 2000)$
ispace : makelist(0, k, 1, 200)$
fixpnt : [];

/* Define the equations */
fsub(x, z1, z2, z3, z4) := [(1-6*x^2*z4-6*x*z3)/x^3];
df : jacobian(fsub(x,z1, z2, z3, z4),[z1,z2,z3,z4]);
dfsub(x, z1, z2, z3, z4) := subst(['x=x,'z1=z1,'z2=z2,'z3=z3,'z4=z4], df);
g(z1, z2, z3, z4) := [z1, z3, z1, z3];
gsub(i, z1, z2, z3, z4) := subst(['z1=z1,'z2=z2,'z3=z3,'z4=z4], g(z1, z2, z3, z4)[i]);
dg:jacobian(g(z1, z2, z3, z4), [z1,z2,z3,z4]);
dgsub(i, z1, z2, z3, z4) := subst(['z1=z1,'z2=z2,'z3=z3,'z4=z4], row(dg, i)[1]);

exact(x) := [.25*(10.*log(2.)-3.)*(1.-x) + .5*(1./x+(3.+x)*log(x)-x),
             -.25*(10.*log(2.)-3.) + .5*(-1./x/x+log(x)+(3.+x)/x-1.),
             .5*(2./x**3+1./x-3./x/x),
             .5*(-6./x**4-1./x/x+6./x**3)];
[iflag, fspace, ispace] :
  colnew_expert(1, m, 1d0, 2d0, zeta, ipar, ltol, tol, fixpnt, ispace, fspace,
 		0, fsub, dfsub, gsub, dgsub, dummy)$

/* Calculate the error at 101 points using the known exact solution */

block([x : 1,
       err : makelist(0d0, k, 1, 4), 
       j],
  for j : 1 thru 101 do
    block([],
      zval : colnew_appsln([x], 4, fspace, ispace)[1],
      u : float(exact(x)),
      err : map(lambda([a,b], max(a,b)), err, abs(u-zval)),
      x : x + 0.01),
  print("The exact errors are:"),
  printf(true, "   ~{ ~11,4e~}~%", err));
