interpolation.c

Go to the documentation of this file.

/*-----------------------------------------------------------------------------------*/
/*  
 *  PURPOSE
 *     interface code for some interpolation / approximation
 *     routines
 *
 *  AUTHOR
 *     Bruno Pincon
 */
/*-----------------------------------------------------------------------------------*/
#include <math.h>
#include <string.h>
#include "interpolation.h"
#include "stack-c.h"
/*-----------------------------------------------------------------------------------*/
extern integer C2F(getfastcode)(unsigned char *c, unsigned long c_len);
/*-----------------------------------------------------------------------------------*/
int good_order(double x[], int n)
{
  /*  test if x[i-1] < x[i] */
  static int first = 1;
  int i;
  static double inf;

  if ( first ) { inf = 1.0 / (double) (first - first) ; first = 0; }

  if (fabs(x[0]) == inf  ||  x[n-1] == inf)
    return ( 0 );

  for ( i = 1 ; i < n ; i++ ) 
    if ( ! (x[i-1] < x[i]) )   /* form of this test for detecting nan ... */ 
      return ( 0 );

  return ( 1 );
}
/*-----------------------------------------------------------------------------------*/
/*
 *  Routines spéciales : 
 *      récupérer une hypermatrice réelle
 *      récupérer une string scilab sans convertion
 *      comparer une string scilab et une C string classique
 *  (elles ne modifient pas les variables correspondantes
 *   ce qui est fondamental pour que cette interface soit
 *   passée par référence).
 */
/*-----------------------------------------------------------------------------------*/
int get_rhs_real_hmat(int num, RealHyperMat *H)
{
  int il, il1, il2, il3,/* it, */lw;

  lw = num + Top - Rhs;
  il = iadr(*Lstk( lw )); 
  if ( *istk(il) < 0 )
    il = iadr(*istk(il+1));
          
  if ( *istk(il) != 17 )
    goto err;
  else if ( *istk(il+1) != 3 )  /* a hm mlist must have 3 fields */
    goto err;

  /*  get the pointers for the 3 fields */
  il1 = sadr(il+6);
  il2 = il1 + *istk(il+3) - 1;
  il3 = il1 + *istk(il+4) - 1;
  il1 = iadr(il1); il2 = iadr(il2); il3 = iadr(il3);

  /*  test if the first field is a matrix string with 3 components
   *  and that the first is "hm" (ie 17 22  in scilab char code)
   */
  if ( (*istk(il1) != 10)  |  ((*istk(il1+1))*(*istk(il1+2)) != 3)  )
    goto err;
  else if ( *istk(il1+5)-1 != 2 )  /* 1 str must have 2 chars */
    goto err;
  else if ( *istk(il1+8) != 17  || *istk(il1+9) != 22 )
    goto err;

  /*  get the 2d field */
  if ( (*istk(il2) != 8)  |  (*istk(il2+3) != 4) )
    goto err;
  H->dimsize = (*istk(il2+1))*(*istk(il2+2));
  H->dims = istk(il2+4);

  /*  get the 3d field */
  if ( !( *istk(il3) == 1 && *istk(il3+3)==0) )
    goto err;;

  H->size = (*istk(il3+1))*(*istk(il3+2));
  H->R = stk(sadr(il3+4));

  /* needed for Jpc stuff (putlhsvar) */
  Nbvars = Max(Nbvars,num);
  C2F(intersci).ntypes[num-1] = '$';
  C2F(intersci).iwhere[num-1] = *Lstk(lw);
  C2F(intersci).lad[num-1] = 0;  /* a voir ? */
  return 1;

 err:
  Scierror(999,"Argument %d is not a real hypermatrix\r\n", num);
  return 0;
}
/*-----------------------------------------------------------------------------------*/
int get_rhs_scalar_string(int num, int *length, int **tabchar)
{
  int il, lw;

  lw = num + Top - Rhs;
  il = iadr(*Lstk( lw )); 
  if ( *istk(il) < 0 )
    il = iadr(*istk(il+1));
          
  if ( ! ( *istk(il) == 10  &&  (*istk(il+1))*(*istk(il+2)) == 1 ) ) 
    {
      /* we look for a scalar string */
      Scierror(999,"Argument %d is not a scalar string\r\n", num);
      return 0;
    }
  *length = *istk(il+5)-1;
  *tabchar = istk(il+6);

  Nbvars = Max(Nbvars,num);
  C2F(intersci).ntypes[num-1] = '$';
  C2F(intersci).iwhere[num-1] = *Lstk(lw);
  C2F(intersci).lad[num-1] = 0;
  return 1;
}
/*-----------------------------------------------------------------------------------*/
int equal_scistring_and_string(int length, int *scistr,  char *str)
{
  /* compare a scistring with a classic C string */
  int i, res;
  
  if ( strlen(str) != length )
    return 0;

  res = 1; i = 0;
  while (res && i < length)
    {
      res = (scistr[i] == (int)C2F(getfastcode)(str+i,1L));
      i++;
    }
  return (res);
}
/*-----------------------------------------------------------------------------------*/
int get_type(TableType *Tab, int dim_table, int *scistr, int strlength)
{
  int i = 0, found = 0;
  while ( !found  &&  i < dim_table )
    {
      found =  equal_scistring_and_string(strlength, scistr, Tab[i].str_type);
      i++;
    } 
  if ( found )
    return ( Tab[i-1].type );
  else
    return ( UNDEFINED );
} 
/*-----------------------------------------------------------------------------------*/

---