Ejemplo n.º 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;
}
Ejemplo n.º 2
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, &lt);
    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;
}
Ejemplo n.º 3
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, &lt);
    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,  &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);

    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;
}