/*
 * This file contains the code that handles converting
 * to/from S-Lang.
 */

#include <string.h>

#include "slang.h"

/*
 * This is the routine that evaluates the model. It is
 * defined in beta1d_model_f.f. Note that the
 * arguments are call by reference, not value, for fortran.
 *
 * The Fortran routine is called one of
 *     evaluate_beta1d_
 *     evaluate_beta1d__
 * (ie with one or two underscores appended to the name).
 * This depends on the compiler/os used, so try the "__"
 * form if the single underscore does not work.
 */

/* #define SHERPA_USE_DOUBLE_UNDERSCORE 1 */

#ifdef SHERPA_USE_DOUBLE_UNDERSCORE
extern void evaluate_beta1d__(double *r0,
			      double *beta,
			      double *xpos,
			      double *ampl,
			      double *x,
			      double *y,
			      int *nelem);
#else
extern void evaluate_beta1d_(double *r0,
			     double *beta,
			     double *xpos,
			     double *ampl,
			     double *x,
			     double *y,
			     int *nelem);
#endif

/*
 * The following routine is the code that handles the interface
 * between S-Lang and your model (in this example the
 * evaluate_beta1d routine).
 *
 * It has to handle converting the parameter and axis
 * information from S-Lang, calling the model evaluation
 * routine, and then converting the result into a S-Lang array.
 *
 * The handling of the arguments depends on how the routine
 * is registered with S-Lang (the SLadd_intrinsic_function
 * routine below). In this case we explicitly list all the
 * parameters since we know what types they should be.
 * See the "Intrinsic Functions" section of the
 * "S-Lang Library C Programmer's Guide" available from
 *      http://www.jedsoft.org/slang/docs.html
 * for further information on how to add routines to S-Lang
 * (although these docs are for S-Lang v2 and CIAO uses
 *  S-Lang v1 the interface has not changed).
 */

static void beta1d_interface(double *r0,
			     double *beta,
			     double *xpos,
			     double *ampl,
			     SLang_Array_Type *x)
{
  SLang_Array_Type* y;
  int nelem;
  
  /*
   * Safety check. Should not be needed in production code.
   */
  if (SLANG_DOUBLE_TYPE != x->data_type)
  {
    SLang_verror (SL_USAGE_ERROR,
		  "Usage: _beta1d_um_c (r0, beta, xpos, ampl, Double_Type x[]);");
    SLang_push_null (); /* so that things will fail */
  }

  /* Create memory for output */
  nelem = x->num_elements;
  y = SLang_create_array (SLANG_DOUBLE_TYPE, 0, NULL, &nelem, 1);
  if (NULL==y)
  {
    SLang_verror (SL_MALLOC_ERROR,
		  "Unable to create an array of %d doubles",
		  nelem);
    SLang_push_null (); /* so that things will fail */
  }

  /* Evaluate the model */
#ifdef SHERPA_USE_DOUBLE_UNDERSCORE
  evaluate_beta1d__(r0,
		    beta,
		    xpos,
		    ampl,
		    (double *)(x->data),
		    (double *)(y->data),
		    &nelem);
#else
  evaluate_beta1d_(r0,
		   beta,
		   xpos,
		   ampl,
		   (double *)(x->data),
		   (double *)(y->data),
		   &nelem);
#endif
  
  /*
   * Return the calculated values to S-Lang.
   * The second argument is set to 1 to avoid memory leaks.
   */
  (void) SLang_push_array (y, 1);
}

/*
 * This routine is used to tell S-Lang what routines should
 * be available from S-Lang.
 *
 * It must be called init_<name of module>_module_ns
 * where the shared library is called
 * <name of module>-module.so
 */

SLANG_MODULE(beta1d_um_f);

int init_beta1d_um_f_module_ns(char *ns_name)
{
  SLang_NameSpace_Type *ns = SLns_create_namespace (ns_name);
  if (ns == NULL)
    return -1;

  /*
   * We want Sherpa to call the beta1d_interface routine,
   * using the name "_beta1d_um_f". The leading underscore is
   * not required but does indicate this is a routine that
   * is not expected to be called directly by the user.
   */
  if (-1 == SLadd_intrinsic_function ("_beta1d_um_f",
				      (FVOID_STAR) &beta1d_interface,
				      SLANG_VOID_TYPE,
				      5,
				      SLANG_DOUBLE_TYPE,
				      SLANG_DOUBLE_TYPE,
				      SLANG_DOUBLE_TYPE,
				      SLANG_DOUBLE_TYPE,
				      SLANG_ARRAY_TYPE))
    return -1;
  
   return 0;
}

/* end */
