Ejemplo n.º 1
0
Archivo: math.c Proyecto: hankem/ISIS
static int pop_linear_system (Linear_System_Type *t) /*{{{*/
{
   SLang_Array_Type *sl_a=NULL, *sl_b=NULL;
   double **a=NULL, *b=NULL;
   SLindex_Type i, j, n, dims[2];
   int status = -1;

   t->a = NULL;
   t->b = NULL;
   t->n = 0;

   if ((-1 == SLang_pop_array_of_type (&sl_b, SLANG_DOUBLE_TYPE))
       || (-1 == SLang_pop_array_of_type (&sl_a, SLANG_DOUBLE_TYPE)))
     goto return_error;

   n = sl_b->num_elements;

   if (sl_a->num_elements != (unsigned int) n*n)
     goto return_error;

   if ((NULL == (a = JDMdouble_matrix (n, n)))
       || (NULL == (b = JDMdouble_vector (n))))
     goto return_error;

   memcpy ((char *)b, (char *)sl_b->data, n * sizeof(double));
   for (i = 0; i < n; i++)
     {
        double *ai = a[i];
        if (-1 == SLang_get_array_element (sl_b, &i, &b[i]))
          goto return_error;
        dims[0] = i;
        for (j = 0; j < n; j++)
          {
             double aij;
             dims[1] = j;
             if (-1 == SLang_get_array_element (sl_a, dims, &aij))
               goto return_error;
             ai[j] = aij;
          }
     }

   t->a = a;
   t->b = b;
   t->n = n;

   status = 0;
return_error:
   SLang_free_array (sl_a);
   SLang_free_array (sl_b);
   return status;
}
Ejemplo n.º 2
0
static int move_to_hook_matched_hdu (cfitsfile *fptr, const char *hook_name)
{
   SLang_Array_Type *as = NULL;
   int status = -1;
   SLindex_Type i, num;
   char *s;

   if (hook_name == NULL)
     return -1;

   /* Does the user-defined hook exist? */
   if (2 != SLang_is_defined ((char *) hook_name))
     return -1;

   if ((-1 == SLang_run_hooks ((char *)hook_name, 0))
       || (-1 == SLang_pop_array_of_type (&as, SLANG_STRING_TYPE)))
     goto return_error;

   num = as->num_elements;

   for (i = 0; i < num; i++)
     {
        if (-1 == SLang_get_array_element (as, &i, &s))
          goto return_error;
        if (0 == cfits_movnam_hdu (fptr, s))
          {
             status = 0;
             break;
          }
     }

return_error:
   SLang_free_array (as);
   return status;
}
Ejemplo n.º 3
0
static int call_ionpop_modifier (Model_t *m, Model_Info_Type *info, float *ionpop_new) /*{{{*/
{
   Plasma_State_Type s;
   SLang_Array_Type *sl_ionpop = NULL;
   int Z, q, status = -1;
   int n = ISIS_MAX_PROTON_NUMBER;

   s.temperature = m->temperature;
   s.ndensity = m->density;

   /* Float_Type[n,n] = ionpop_modifier (params, state, last_ionpop, [,args]) */
   SLang_start_arg_list ();
   SLang_push_array (info->ionpop_params, 0);
   if (-1 == SLang_push_cstruct ((VOID_STAR)&s, Plasma_State_Layout))
     {
        SLang_end_arg_list ();
        return -1;
     }
   SLang_push_array (m->last_ionpop, 0);
   if (info->ionpop_args != NULL)
     isis_push_args (info->ionpop_args);

   if (info->ionpop_qualifiers == NULL)
     {
        SLang_end_arg_list ();

        if (-1 == SLexecute_function (info->ionpop_modifier))
          return -1;
     }
   else
     {
        if ((-1 == SLang_push_function (info->ionpop_modifier))
            || (-1 == SLang_push_struct (info->ionpop_qualifiers)))
          return -1;

        SLang_end_arg_list ();

        if (-1 == SLang_execute_function ("_isis->do_eval_with_qualifiers"))
          return -1;
     }

   if (-1 == SLang_pop_array_of_type (&sl_ionpop, SLANG_FLOAT_TYPE))
     return -1;

   if ((sl_ionpop == NULL)
       || (sl_ionpop->num_dims != 2)
       || ((sl_ionpop->dims[0] != n+1) || (sl_ionpop->dims[1] != n+1)))
     {
        isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__,
                    "ionpop_modifier: invalid return value, expecting: Float_Type[n,n] with n=%d", n+1);
        goto return_status;
     }

   for (Z = 1; Z <= n; Z++)
     {
        for (q = 0; q <= Z; q++)
          {
             int i[2];
             i[0] = Z;  i[1] = q;
             if (-1 == SLang_get_array_element (sl_ionpop, i, &ionpop_new[Z*(n+1)+q]))
               goto return_status;
          }
     }

   SLang_free_array (m->last_ionpop);
   m->last_ionpop = sl_ionpop;

   status = 0;
return_status:
   if (status != 0)
     {
       SLang_free_array (sl_ionpop);
     }

   return status;
}