/*--------------------------------------------------------------------------*/
int intinterp3d(char *fname, unsigned long fname_len)
{
/*
* [f [, dfdx, dfdy, dfdz]] = interp3d(xp, yp, zp, tlcoef [,outmode])
*/
int minrhs = 4, maxrhs = 5, minlhs = 1, maxlhs = 4;
int mxp = 0, nxp = 0, lxp = 0, myp = 0, nyp = 0, lyp = 0, mzp = 0, nzp = 0, lzp = 0, mt = 0, nt = 0, lt = 0, np = 0;
int one = 1, kx = 0, ky = 0, kz = 0;
int nx = 0, ny = 0, nz = 0, nxyz = 0, mtx = 0, mty = 0, mtz = 0, m = 0, n = 0;
int ltx = 0, lty = 0, ltz = 0, lbcoef = 0, mwork = 0, lwork = 0, lfp = 0;
int lxyzminmax = 0, nsix = 0, outmode = 0, ns = 0, *str_outmode = NULL;
int m1 = 0, n1 = 0, ldfpdx = 0, ldfpdy = 0, ldfpdz = 0;
double *fp = NULL, *xp = NULL, *yp = NULL, *zp = NULL, *dfpdx = NULL, *dfpdy = NULL, *dfpdz = NULL;
double *xyzminmax = 0, xmin = 0, xmax = 0, ymin = 0, ymax = 0, zmin = 0, zmax = 0;
SciIntMat Order;
int *order = NULL;
char **Str = NULL;
int i = 0;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &lxp);
xp = stk(lxp);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &myp, &nyp, &lyp);
yp = stk(lyp);
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mzp, &nzp, &lzp);
zp = stk(lzp);
for (i = 1; i <= minrhs - 1; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
return 0;
}
}
if ( mxp != myp || nxp != nyp || mxp != mzp || nxp != nzp)
{
Scierror(999,_("%s: Wrong size for input arguments #%d, #%d and #%d: Same sizes expected.\n"),fname,1,2,3);
return 0;
}
np = mxp * nxp;
GetRhsVar(4, TYPED_LIST_DATATYPE,&mt, &nt, <);
GetListRhsVar(4, 1,MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str);
if ( strcmp(Str[0],"tensbs3d") != 0)
{
/* Free Str */
if (Str)
{
int i = 0;
while (Str[i] != NULL)
{
FREE(Str[i]);
i++;
};
FREE(Str);
Str = NULL;
}
Scierror(999,_("%s: Wrong type for input argument #%d: %s tlist expected.\n"), fname,4,"tensbs3d");
return 0;
}
/* Free Str */
if (Str)
{
int i = 0;
while (Str[i] != NULL)
{
FREE(Str[i]);
i++;
};
FREE(Str);
Str = NULL;
}
GetListRhsVar(4, 2,MATRIX_OF_DOUBLE_DATATYPE, &mtx, &n, <x);
GetListRhsVar(4, 3,MATRIX_OF_DOUBLE_DATATYPE, &mty, &n, <y);
GetListRhsVar(4, 4,MATRIX_OF_DOUBLE_DATATYPE, &mtz, &n, <z);
GetListRhsVar(4, 5,MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m , &n, (int *)&Order);
GetListRhsVar(4, 6,MATRIX_OF_DOUBLE_DATATYPE, &nxyz,&n, &lbcoef);
GetListRhsVar(4, 7,MATRIX_OF_DOUBLE_DATATYPE, &nsix,&n, &lxyzminmax);
xyzminmax = stk(lxyzminmax);
xmin = xyzminmax[0];
xmax = xyzminmax[1];
ymin = xyzminmax[2];
ymax = xyzminmax[3];
zmin = xyzminmax[4];
zmax = xyzminmax[5];
/* get the outmode */
if ( Rhs == 5 )
{
GetRhsScalarString(5, &ns, &str_outmode);
outmode = get_type(OutModeTable, NB_OUTMODE, str_outmode, ns);
if ( outmode == UNDEFINED || outmode == LINEAR || outmode == NATURAL )
{
Scierror(999,_("%s: Wrong values for input argument #%d: Unsupported '%s' type.\n"),fname,5,"outmode");
return 0;
}
}
else
{
outmode = C0;
}
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &lfp); fp = stk(lfp);
order = (int *)Order.D;
kx = order[0];
ky = order[1];
kz = order[2];
nx = mtx - kx;
ny = mty - ky;
nz = mtz - kz;
mwork = ky * kz + 3 *Max(kx, Max(ky, kz)) + kz;
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &mwork, &one, &lwork);
if (Lhs == 1)
{
C2F(driverdb3val)(xp,yp,zp,fp,&np,stk(ltx), stk(lty), stk(ltz),
&nx, &ny, &nz, &kx, &ky, &kz, stk(lbcoef), stk(lwork),
&xmin, &xmax, &ymin, &ymax, &zmin, &zmax, &outmode);
LhsVar(1) = Rhs + 1;
}
else
{
CreateVar(Rhs + 3, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &ldfpdx);
dfpdx = stk(ldfpdx);
CreateVar(Rhs + 4, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &ldfpdy);
dfpdy = stk(ldfpdy);
CreateVar(Rhs + 5, MATRIX_OF_DOUBLE_DATATYPE, &mxp, &nxp, &ldfpdz);
dfpdz = stk(ldfpdz);
C2F(driverdb3valwithgrad)(xp,yp,zp,fp,dfpdx, dfpdy, dfpdz, &np,
stk(ltx), stk(lty), stk(ltz),
&nx, &ny, &nz, &kx, &ky, &kz, stk(lbcoef), stk(lwork),
&xmin, &xmax, &ymin, &ymax, &zmin, &zmax, &outmode);
LhsVar(1) = Rhs + 1;
LhsVar(2) = Rhs + 3;
LhsVar(3) = Rhs + 4;
LhsVar(4) = Rhs + 5;
}
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int intsplin(char *fname,unsigned long fname_len)
{
int minrhs = 2, maxrhs = 4, minlhs = 1, maxlhs = 1;
int mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, mc = 0, nc = 0, lc = 0, n = 0, spline_type = 0;
int *str_spline_type = NULL, ns = 0;
int ld = 0, i = 0;
int mwk1 = 0, nwk1 = 0, lwk1 = 0, mwk2 = 0, nwk2 = 0, lwk2 = 0, mwk3 = 0;
int nwk3 = 0, lwk3 = 0, mwk4 = 0, nwk4 = 0, lwk4 = 0;
double *x = NULL, *y = NULL, *d = NULL, *c = NULL;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);
for (i = 1; i <= minrhs; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument %d: Real matrix expected.\n"), fname, i);
return 0;
}
}
if ( mx != my || nx != ny || (mx != 1 && nx != 1) )
{
Scierror(999,_("%s: Wrong size for input arguments #%d and #%d: Vector of same size expected.\n"), fname, 1, 2);
return 0;
}
n = mx * nx; /* number of interpolation points */
if ( n < 2 )
{
Scierror(999,_("%s: Wrong size for input argument #%d: Must be %s.\n"), fname,1,">= 2");
return 0;
}
x = stk(lx);
y = stk(ly);
if (! good_order(x, n)) /* verify strict increasing abscissae */
{
Scierror(999,_("%s: Wrong value for input argument #%d: Not (strictly) increasing or +-inf detected.\n"), fname,1);
return 0;
}
if ( Rhs >= 3 ) /* get the spline type */
{
GetRhsScalarString(3, &ns, &str_spline_type);
spline_type = get_type(SplineTable, NB_SPLINE_TYPE, str_spline_type, ns);
if ( spline_type == UNDEFINED )
{
Scierror(999,_("%s: Wrong values for input argument #%d: Unknown '%s' type.\n"),fname,3,"spline");
return 0;
};
}
else
{
spline_type = NOT_A_KNOT;
}
if ( spline_type == CLAMPED ) /* get arg 4 which contains the end point slopes */
{
if ( Rhs != 4 )
{
Scierror(999,_("%s: For a clamped spline, you must give the endpoint slopes.\n"),fname);
return 0;
}
GetRhsVar(4,MATRIX_OF_DOUBLE_DATATYPE, &mc, &nc, &lc);
if ( mc*nc != 2 )
{
Scierror(999,_("%s: Wrong size for input argument #%d: Endpoint slopes.\n"),fname,4);
return 0;
}
c = stk(lc);
}
else if ( Rhs == 4 )
{
Scierror(999,_("%s: Wrong number of input argument(s).\n"),fname);
return 0;
}
/* verify y(1) = y(n) for periodic splines */
if ( (spline_type == PERIODIC || spline_type == FAST_PERIODIC) && y[0] != y[n-1] )
{
Scierror(999,_("%s: Wrong value for periodic spline %s: Must be equal to %s.\n"),fname,"y(1)","y(n)");
return(0);
};
CreateVar(Rhs+1,MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ld); /* memory for d (only argument returned) */
d = stk(ld);
switch(spline_type)
{
case(FAST) : case(FAST_PERIODIC) :
nwk1 = 1;
C2F(derivd) (x, y, d, &n, &nwk1, &spline_type);
break;
case(MONOTONE) :
nwk1 = 1;
C2F(dpchim) (&n, x, y, d, &nwk1);
break;
case(NOT_A_KNOT) : case(NATURAL) : case(CLAMPED) : case(PERIODIC) :
/* (the wk4 work array is used only in the periodic case) */
mwk1 = n; nwk1 = 1; mwk2 = n-1; nwk2 = 1; mwk3 = n-1; nwk3 = 1; mwk4 = n-1; nwk4 = 1;
CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE, &mwk1, &nwk1, &lwk1);
CreateVar(Rhs+3,MATRIX_OF_DOUBLE_DATATYPE, &mwk2, &nwk2, &lwk2);
CreateVar(Rhs+4,MATRIX_OF_DOUBLE_DATATYPE, &mwk3, &nwk3, &lwk3);
lwk4 = lwk1;
if (spline_type == CLAMPED)
{ d[0] = c[0]; d[n-1] = c[1]; };
if (spline_type == PERIODIC)
{
CreateVar(Rhs+5,MATRIX_OF_DOUBLE_DATATYPE, &mwk4, &nwk4, &lwk4);
}
C2F(splinecub) (x, y, d, &n, &spline_type, stk(lwk1), stk(lwk2), stk(lwk3), stk(lwk4));
break;
}
LhsVar(1) = Rhs+1;
PutLhsVar();
return 0;
}
/*--------------------------------------------------------------------------*/
int intinterp1(char *fname, unsigned long fname_len)
{
int minrhs = 4, maxrhs = 5, minlhs = 1, maxlhs = 4;
int mt = 0, nt = 0, lt = 0, mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, md = 0, nd = 0, ld = 0, ns = 0;
int *str_outmode = NULL;
int n = 0, m = 0, outmode = 0, lst = 0, ldst = 0, lddst = 0, ldddst = 0;
int i = 0;
CheckRhs(minrhs, maxrhs);
CheckLhs(minlhs, maxlhs);
GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, <);
GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lx);
GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &my, &ny, &ly);
GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &md, &nd, &ld);
if ( mx != my || nx != ny || md != mx || nd != nx || (mx != 1 && nx != 1) || mx*nx < 2)
{
Scierror(999,_("%s: Wrong size for input arguments #%d and #%d: Same sizes expected.\n"),fname,2,3);
return 0;
}
n = mx * nx; /* number of interpolation points */
m = mt * nt; /* number of points to interpolate */
for (i = 1; i <= minrhs; i++)
{
SciErr sciErr;
int *piAddressVar = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, i, &piAddressVar);
if(sciErr.iErr)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, i);
return 0;
}
if (isVarComplex(pvApiCtx, piAddressVar))
{
Scierror(202, _("%s: Wrong type for argument #%d: Real matrix expected.\n"), fname, i);
return 0;
}
}
if ( Rhs == 5 ) /* get the outmode */
{
GetRhsScalarString(5, &ns, &str_outmode);
outmode = get_type(OutModeTable, NB_OUTMODE, str_outmode, ns);
if ( outmode == UNDEFINED )
{
Scierror(999,_("%s: Wrong values for input argument #%d: Unknown '%s' type.\n"),fname,5,"outmode");
return 0;
};
}
else
{
outmode = C0; /* default outmode */
}
/* memory for st, dst, ddst, dddst */
CreateVar(Rhs + 1, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, &lst);
CreateVar(Rhs + 2, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, &ldst);
CreateVar(Rhs + 3, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, &lddst);
CreateVar(Rhs + 4, MATRIX_OF_DOUBLE_DATATYPE, &mt, &nt, &ldddst);
/* subroutine EvalPWHermite(t, st, dst, ddst, dddst, m, x, y, d, n, outmode)
* int m, n, outmode
* double precision t(m), st(m), dst(m), ddst(m), dddst(m), x(n), y(n), d(n)
*/
C2F(evalpwhermite) (stk(lt), stk(lst), stk(ldst), stk(lddst), stk(ldddst),
&m, stk(lx), stk(ly), stk(ld), &n, &outmode);
LhsVar(1) = Rhs + 1;
LhsVar(2) = Rhs + 2;
LhsVar(3) = Rhs + 3;
LhsVar(4) = Rhs + 4;
PutLhsVar();
return 0;
}