/*--------------------------------------------------------------------------*/ 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 inteval_cshep2d(char *fname, unsigned long fname_len) { /* * [f [,dfdx, dfdy [, dffdxx, dffdxy, dffdyy]]] = eval_cshep2d(xp, yp, tlcoef) */ int minrhs = 3, maxrhs = 3, minlhs = 1, maxlhs = 6; int mx = 0, nx = 0, lx = 0, my = 0, ny = 0, ly = 0, mt = 0, nt = 0, lt = 0; char **Str = NULL; int m1 = 0, n1 = 0, m2 = 0, n2 = 0, m3 = 0, n3 = 0, m4 = 0, n4 = 0, m5 = 0, n5 = 0, m6 = 0, n6 = 0, m7 = 0, n7 = 0, m8 = 0, n8 = 0; int lxyz = 0, lgrid = 0, lrmax = 0, lrw = 0, la = 0; double *xp = NULL, *yp = NULL, *xyz = NULL, *grid = NULL, *f = NULL, *dfdx = NULL, *dfdy = NULL, *dffdxx = NULL, *dffdyy = NULL, *dffdxy = NULL; int i = 0, ier = 0, n = 0, np = 0, nr = 0, lf = 0, ldfdx = 0, ldfdy = 0, ldffdxx = 0, ldffdyy = 0, ldffdxy = 0; SciIntMat Cell, Next; int *cell = NULL, *next = 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 - 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 ( mx != my || nx != ny ) { Scierror(999, _("%s: Wrong size for input arguments #%d and #%d: Same sizes expected.\n"), fname, 1, 2); return 0; } GetRhsVar(3, TYPED_LIST_DATATYPE, &mt, &nt, <); GetListRhsVar(3, 1, MATRIX_OF_STRING_DATATYPE, &m1, &n1, &Str); /* m1 = 1, n1 = 8 ? a verifier */ if ( strcmp(Str[0], "cshep2d") != 0) { /* Free Str */ if (Str) { int li = 0; while ( Str[li] != NULL) { FREE(Str[li]); Str[li] = NULL; li++; }; FREE(Str); Str = NULL; } Scierror(999, _("%s: Wrong type for input argument #%d: %s tlist expected.\n"), fname, 2, "cshep2d"); return 0; } /* Free Str */ if (Str) { int li = 0; while ( Str[li] != NULL) { FREE(Str[li]); Str[li] = NULL; li++; }; FREE(Str); Str = NULL; } GetListRhsVar(3, 2, MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &lxyz); /* m2 = n , n2 = 3 */ GetListRhsVar(3, 3, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m3, &n3, (int *)&Cell); /* m3 = nr, n3 = nr */ GetListRhsVar(3, 4, MATRIX_OF_VARIABLE_SIZE_INTEGER_DATATYPE, &m4, &n4, (int *)&Next); /* m4 = 1 , n4 = n */ GetListRhsVar(3, 5, MATRIX_OF_DOUBLE_DATATYPE, &m5, &n5, &lgrid); /* m5 = 1 , n5 = 4 */ GetListRhsVar(3, 6, MATRIX_OF_DOUBLE_DATATYPE, &m6, &n6, &lrmax); /* m6 = 1 , n6 = 1 */ GetListRhsVar(3, 7, MATRIX_OF_DOUBLE_DATATYPE, &m7, &n7, &lrw); /* m7 = 1 , n7 = n */ GetListRhsVar(3, 8, MATRIX_OF_DOUBLE_DATATYPE, &m8, &n8, &la); /* m8 = 9 , n8 = n */ cell = (int *)Cell.D; next = (int *)Next.D; xp = stk(lx); yp = stk(ly); np = mx * nx; n = m2; nr = m3; xyz = stk(lxyz); grid = stk(lgrid); CreateVar(4, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &lf); f = stk(lf); if ( Lhs > 1 ) { CreateVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldfdx); dfdx = stk(ldfdx); CreateVar(6, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldfdy); dfdy = stk(ldfdy); } if ( Lhs > 3 ) { CreateVar(7, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdxx); dffdxx = stk(ldffdxx); CreateVar(8, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdxy); dffdyy = stk(ldffdxy); CreateVar(9, MATRIX_OF_DOUBLE_DATATYPE, &mx, &nx, &ldffdyy); dffdxy = stk(ldffdyy); } switch ( Lhs ) { case ( 1 ) : for ( i = 0 ; i < np ; i++ ) /* DOUBLE PRECISION FUNCTION CS2VAL (PX,PY,N,X,Y,F,NR, * LCELL,LNEXT,XMIN,YMIN,DX,DY,RMAX,RW,A) */ f[i] = C2F(cs2val)(&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2 * n], &nr, cell, next, grid, &grid[1], &grid[2], &grid[3], stk(lrmax), stk(lrw), stk(la)); LhsVar(1) = 4; break; case ( 2 ) : case ( 3 ) : for ( i = 0 ; i < np ; i++ ) /* SUBROUTINE CS2GRD (PX,PY,N,X,Y,F,NR,LCELL,LNEXT,XMIN, *. YMIN,DX,DY,RMAX,RW,A, C,CX,CY,IER) */ C2F(cs2grd) (&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2 * n], &nr, cell, next, grid, &grid[1], &grid[2], &grid[3], stk(lrmax), stk(lrw), stk(la), &f[i], &dfdx[i], &dfdy[i], &ier); LhsVar(1) = 4; LhsVar(2) = 5; LhsVar(3) = 6; break; case ( 4 ) : case ( 5 ) : case ( 6 ) : for ( i = 0 ; i < np ; i++ ) { /* SUBROUTINE CS2HES (PX,PY,N,X,Y,F,NR,LCELL,LNEXT,XMIN, *. YMIN,DX,DY,RMAX,RW,A, C,CX,CY,CXX,CXY,CYY,IER) */ C2F(cs2hes) (&xp[i], &yp[i], &n, xyz, &xyz[n], &xyz[2 * n], &nr, cell, next, grid, &grid[1], &grid[2], &grid[3], stk(lrmax), stk(lrw), stk(la), &f[i], &dfdx[i], &dfdy[i], &dffdxx[i], &dffdxy[i], &dffdyy[i], &ier); } LhsVar(1) = 4; LhsVar(2) = 5; LhsVar(3) = 6; LhsVar(4) = 7; LhsVar(5) = 8; LhsVar(6) = 9; break; } PutLhsVar(); return 0; }
/*--------------------------------------------------------------------------*/ int intbsplin3val(char *fname, unsigned long fname_len) { /* * [fp] = bsplin3val(xp, yp, zp, tlcoef, der) */ int minrhs = 5, maxrhs = 5, minlhs = 1, maxlhs = 1; int mxp = 0, nxp = 0, lxp = 0, myp = 0, nyp = 0, lyp = 0, mzp = 0, nzp = 0, lzp = 0; int mt = 0, nt = 0, lt = 0, m1 = 0, n1 = 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, ltx; int lty = 0, ltz = 0, lbcoef = 0, mwork = 0, lwork = 0, lfp = 0; int i = 0, mder = 0, nder = 0, lder = 0, ox = 0, oy = 0, oz = 0; double *fp = NULL, *xp = NULL, *yp = NULL, *zp = NULL, *der = NULL; SciIntMat Order; int *order = NULL; char **Str = NULL;; 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 <= 3; 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 li = 0; while (Str[li] != NULL) { FREE(Str[li]); li++; }; 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 li = 0; while (Str[li] != NULL) { FREE(Str[li]); li++; }; 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); GetRhsVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mder, &nder, &lder); der = stk(lder); if ( mder*nder != 3 || der[0] != floor(der[0]) || der[0] < 0.0 || der[1] != floor(der[1]) || der[1] < 0.0 || der[2] != floor(der[2]) || der[2] < 0.0 ) { Scierror(999, _("%s: Wrong values for input argument #%d.\n"), fname, 5); return 0; } ox = (int) der[0]; oy = (int) der[1]; oz = (int) der[2]; 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); for (i = 0; i < np; i++) { fp[i] = C2F(db3val)(&(xp[i]), &(yp[i]), &(zp[i]), &ox, &oy, &oz, stk(ltx), stk(lty), stk(lty), &nx, &ny, &nz, &kx, &ky, &kz, stk(lbcoef), stk(lwork)); } LhsVar(1) = Rhs + 1; PutLhsVar(); return 0; }