Пример #1
0
/*--------------------------------------------------------------------------*/
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, &lt);
    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,  &ltx);
    GetListRhsVar(4, 3,MATRIX_OF_DOUBLE_DATATYPE, &mty, &n,  &lty);
    GetListRhsVar(4, 4,MATRIX_OF_DOUBLE_DATATYPE, &mtz, &n,  &ltz);
    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;
}
Пример #2
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;
}
Пример #3
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, &lt);
    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;
}